#!initialize

	# Nameserver IP
	VarSet($IP,"212.27.32.6")

Return(0)

#######################################################################
# MailFlush.hsm
# ¯¯¯¯¯¯¯¯¯¯¯¯¯
# Description:
# 
# This module converts Hamster to a real mail server with dns queries
# lookup and direct sending (without relaying and one message per
# recipient).
#
# Bounce sending to admin in case of unreachable DNS or non-existant
# domain name.
#
# Notes and installation:
#
# Needs win9x version nslookup.exe downloadable here:
#	http://ozolli.free.fr/script/nslookup.exe
# or here :
#	http://www.glegouic.firstream.net/telech.php
# This file must take place in Hamster's root directory.
#
# The way Hamster deals with mail sending leads to stop the local SMTP
# server while mails are being sent with this module. It Is
# automatically done by the module (stop and restart local server).
#
# Your preferred nameserver's IP must be written above in this line:
#	VarSet($IP,"www.xxx.yyy.zzz")
#
# How to use this module:
#
# Declare it in your favorite sendmail script:
#		#!load MailFlush.hsm
# Replace all your HamSendMail lines with this command:
#		Flush
#
# English nslookup version dated 05/04/2002 (ozolli@hamster-fr.org)
# Thanks to the judicious hints from Gildas Le Gouic and Jérôme Fièvre
#######################################################################

Sub Flush

# Variables initialisation
var($Msg,$nb_msg,$ListeRCPT,$RCPT,$Header,$Defer,$FichierEnvoi)
Var($ContenuMsg,$i,$j,$Resultat,$FichierMsg,$Numero)

# Lists initialisation
$Msg=ListAlloc
$ContenuMsg=ListAlloc
$ListeRCPT=ListAlloc

# Stops local SMTP server
HamMessage(5,0)

# Changes extension from .msg to .q
$nb_msg=ListFiles($Msg,HamMailsOutPath+"*.msg",1)-1 # Full path
For($i,0,$nb_msg,1)
	$FichierMsg=ListGet($Msg,$i)
	FileRename($FichierMsg,Replace($FichierMsg,".msg",".q"))
	ListSet($Msg,$i,Replace($FichierMsg,".msg",".q"))
Endfor

# Ready to send mails loading loop
For($i,0,$nb_msg,1)

	$FichierMsg=ListGet($Msg,$i)

	# Contents of $FichierMsg message loading in $ContenuMsg
	# $ContenuMsg and $ListeRCPT are first reset
	ListClear($ContenuMsg)
	ListClear($ListeRCPT)
	ListLoad($ContenuMsg,$FichierMsg)

	# !RCPT TO: extraction and making of $ListeRCPT
	Do
		$RCPT=ListGet($ContenuMsg,1)
		RE_Parse($RCPT,"(.*:)",$Header)
		Break($Header!="!RCPT TO:")
		ListAdd($ListeRCPT,$RCPT)
		ListDelete($ContenuMsg,1)
	Loop

	# Sending of one message's copy per !RCPT TO:
	RE_Parse($FichierMsg,"(.*)\.q",$FichierMsg)
	If(Pos("-",$FichierMsg))
		$Defer=1
	Else
		$Defer=0
	Endif

	For($j,0,ListCount($ListeRCPT)-1,1)
		$RCPT=ListGet($ListeRCPT,$j)
		ListInsert($ContenuMsg,1,$RCPT)
		If($Defer)
			$FichierEnvoi=$FichierMsg+".msg"
		Else
			$Numero=Int(IniRead(HamPath+"Hamster.ini","Setup",_
				"mail.number.lastused",0))+1
			IniWrite(HamPath+"Hamster.ini","Setup",_
				"mail.number.lastused",$Numero)
			$FichierEnvoi=HamMailsOutPath+$Numero+".msg"
		Endif
		Listsave($ContenuMsg,$FichierEnvoi)
		$Resultat=nslookup($RCPT)

		# If the message could not be sent
		If($Resultat=1)
			FileRename($FichierEnvoi,Replace($FichierEnvoi,".msg",".q"))
		Endif

		# If the domain name in unreachable or do not exist
		If($Resultat>1)
			Bounce($FichierEnvoi,$ContenuMsg,$Resultat)
			FileRename($FichierEnvoi,Replace($FichierEnvoi,".msg",".q"))
		Endif

		ListDelete($ContenuMsg,1)
	Endfor

	# Original file deletion
	FileDelete($FichierMsg+".q")
Endfor

# Changes extension from .q to .msg if some are 'deferred msg'
If(FileExists(HamMailsOutPath+"*.q"))
	ListClear($Msg)
	$nb_msg=ListFiles($Msg,HamMailsOutPath+"*.q",1)-1 # Full path
	For($i,0,$nb_msg,1)
		$FichierMsg=ListGet($Msg,$i)
		FileRename($FichierMsg,Replace($FichierMsg,".q",".msg"))
	Endfor
Endif

# Frees lists
listfree($Msg)
listfree($ContenuMsg)
listfree($ListeRCPT)

# Restarts local SMTP server
HamMessage(5,1)

EndSub

#######################################################################

Sub nslookup($dns)

Var($nslookup,$Listemx,$Listens,$mx,$ns,$priority,$ErrCode)
VarSet($i,3)

$nslookup=ListAlloc
$Listens=ListAlloc
$Listemx=ListAlloc(1,1)

# Prints !RCPT TO and extracts domain name
Print($dns)
RE_Parse($dns,".*@(.*)>",$dns)

# Primary query
Execute("command.com /c nslookup.exe -type=MX -nosea "+_
$dns+" "+$IP+" > nslookup.txt",HamPath,0,1)

# Primary query results loading in $nslookup
ListClear($nslookup)
ListClear($Listens)
ListClear($Listemx)
ListLoad($nslookup,"nslookup.txt")

# If the nameserver is not answering
If(FileSize("nslookup.txt")=0)
	Addlog("DNS "+$IP+" unreachable, delivery cancelled.",6)
	$ErrCode=2
	listfree($nslookup)
	listfree($Listemx)
	listfree($Listens)
	Return($ErrCode)
Endif

# If this was not an authority reply
If(ListGet($nslookup,3)="Non-authoritative answer:")
	$i=4

	# Authoritative answers text block lookup
	Do
		$ns=ListGet($nslookup,$i)
		Break((Pos("Authoritative answers can be found from:",_
			$ns))||($i>=ListCount($nslookup)-1))
		Inc($i)
	Loop
	Inc($i)

	# Authoritative nameservers lookup
	Do
		$ns=ListGet($nslookup,$i)
		Break((!Pos("nameserver",$ns))||($i>=ListCount($nslookup)-1))
		RE_Parse($ns,".*\=\s+(.*)",$ns)
		$ns=Trim(ListGetKey($nslookup,$ns+chr(9)+"internet address "))
		ListAdd($Listens,$ns)
		Inc($i)
	Loop
	$i=0

	# Authority query
	Do
		$ns=ListGet($Listens,$i)
		Break($ns="")
		Execute("command.com /c nslookup.exe -type=MX -nosea "+_
			$dns+" "+$IP+" > nslookup.txt",HamPath,0,1)
		ListClear($nslookup)
		ListLoad($nslookup,"nslookup.txt")
		$mx=ListGet($nslookup,3)
		Break(Pos("mail exchanger",$mx))
		inc($i)
	Loop
Endif

$i=3

# MX records lookup
Do
	$mx=ListGet($nslookup,$i)
	Break((Pos("mail exchanger",$mx))||($i>=ListCount($nslookup)-1))
	Inc($i)
Loop

# If the domain has no MX record
If(!Pos("mail exchanger",$mx))

	# A records lookup


	Execute("command.com /c nslookup.exe -type=A -nosea "+_
		$dns+" "+$IP+" > nslookup.txt",HamPath,0,1)
	ListClear($nslookup)
	ListLoad($nslookup,"nslookup.txt")
	$i=1
	Do
		$mx=ListGet($nslookup,ListCount($nslookup)-$i)
		Break($mx!="")
		Inc($i)
	Loop
	$mx=ListGet($nslookup,ListCount($nslookup)-$i-1)

	# If the domain has no A record we consider the domain
	# not existing unless it is a nameserver problem.
	If(!Pos($dns,$mx))
		If(FileSize("nslookup.txt")!=0)
			Addlog("Domain "+$dns+" does not exist, delivery cancelled.",6)
			$ErrCode=3
		Endif
		listfree($nslookup)
		listfree($Listemx)
		listfree($Listens)
		Return($ErrCode)

	# If the domain has one A record
	# we consider this record target as a MX (RFC 2821)
	Else
		ListAdd($Listemx,$dns)
	Endif

# If the domain has at least one MX record
# Sorting of MX records by priority order
Else
	Do
		$mx=ListGet($nslookup,$i)
		Break(!Pos("mail exchanger",$mx))
		RE_Parse($mx,".*\=\s+([0-9]*).*\=\s+(.*)",$priority,$mx)
		$mx=str($priority,3)+$mx
		ListAdd($Listemx,$mx)
		Inc($i)
	Loop

Endif

$i=0

# Message sending by MX records priority (if any).
Do
	$mx=ListGet($Listemx,$i)
	Break($mx="")
	RE_Parse($mx,"[0-9]*(.*)",$mx)
	print("Serveur SMTP : "+$mx)
	HamSendMail($mx)
	HamWaitIdle
	Break(!FileExists(HamMailsOutPath+"*.msg"))
	inc($i)
Loop

# Frees lists
listfree($nslookup)
listfree($Listemx)
listfree($Listens)

HamWaitIdle

# Returns 1 if the messages has not be sent
Return(FileExists(HamMailsOutPath+"*.msg"))

EndSub

#######################################################################


Sub Bounce($FichierMsg,$ContenuMsg,$ErrCode)

# Modules initialisation
#!load Bmsgheader.hsm
#!load Htime.hsm

# Variables initialisation
VarSet($Bounce,0)
VarSet($i,0)
VarSet($Header,"")
var($date,$from,$to,$dns,$subject,$mid)

$Bounce=ListAlloc

# Loads !RCPT TO and extracts the domain name
$dns=Trim(Trim(MsgGetHeader($ContenuMsg,"!RCPT TO:"),"<"),">")
RE_Parse($dns,".*@(.*)",$dns)


# Error code resolution
$Errcode=icase($Errcode,_
	2,"DNS "+$IP+" unreachable, delivery cancelled.",_
	3,"Domain "+$dns+" does not exist, delivery cancelled.",_
	Else,"")
$mid=IniRead(HamPath+"Hamster.ini","Setup","FQDN","localhost")
$mid=timegmt+"."+hex(ticks)+"@"+$mid

# Bounce headers
MsgAddHeader($Bounce,"From:",_
	"""Hamster-Info"" <local-hamster-info@hamster.invalid>")
MsgAddHeader($Bounce,"To:","<admin@hamster.invalid>")	 
MsgAddHeader($Bounce,"Date:",DateStdGMT(TimeGMT))
MsgAddHeader($Bounce,"Subject:",_
	"[Hamster] Echec dans l'envoi d'un message !") 
MsgAddHeader($Bounce,"Message-Id:",$mid)	 

# Bounce body
ListAdd($Bounce,_
	"The following mail could not be delivered:")
ListAdd($Bounce)
ListAdd($Bounce,"> "+$FichierMsg)

ListAdd($Bounce)
ListAdd($Bounce,"Delivery-results:")
ListAdd($Bounce)
ListAdd($Bounce,$Errcode)
ListAdd($Bounce)
ListAdd($Bounce,"Header-lines of undelivered mail:")
ListAdd($Bounce)
Do
	$Header=ListGet($ContenuMsg,$i)
	Break($Header="")
	ListAdd($Bounce,"| "+$Header)
	Inc($i)
Loop

# Saves the bounce in the admin's mailbox
ListSave($Bounce,HamMailPath+"admin\"+Time+Ticks+".msg")

# Frees lists
listfree($Bounce)

EndSub

#######################################################################


Sub DateStdGMT ( $time )

Var( $heure, $h, $mn, $s, $an, $mois, $j, $jours )

decodetime( $time, $an, $mois, $j )
$jours = copy("SunMonTueWedThuFriSat",DayOfWeek($time)*3-2,3)
$mois = copy("JanFebMarAprMayJunJulAugSepOctNovDec", Months($time)*3-2,3)
$heure = TimeStr( $time )

return( $jours + ", " + $j + " " + $mois + " " + $an + " " +  $heure +" GMT" )

Endsub

########################################################################
# Months: Returns the month for a given timepoint.
########################################################################
# [IN]  $iDateTime: time in unix-format
# [OUT] (result)  : 1 (=January), 2 (=February), ..., 12 (=December)
# Example: print( copy("SunMonTueWedThuFriSat",DayOfWeek(time)*3-2,3) )

sub Months( $iDateTime )
   var( $dow )
   decodetime( $iDateTime, 0, $dow, 0, 0, 0, 0, 0 )
   return( $dow )
endsub
 
########################################################################
# MsgHeadernameOfIndex: Retourne le nom de l'entête de la ligne indiquée.
########################################################################
# [ENTREE]  $ListeMsg : liste contenant le message (une ligne par entrée)
#       $Index_ligne  : index dans la liste pointant vers une ligne d'entête
# [SORTIE] (résultat) : nom de l'entête  incluant ":" ;
#                       chaîne vide si l'index n'existe pas.
# Exemple: $ChampEntetes = MsgHeadernameOfIndex( $ListeMsg, 2 )

sub MsgHeadernameOfIndex( $ListeMsg, $Index_ligne )

   var( $s, $i )

   $s = ListGet( $ListeMsg, $Index_ligne )
   $i = Pos( ":", $s )
   $s = iif( $i>0, copy($s,1,$i), "" )

   return( $s )

endsub

########################################################################
# MsgIndexOfHeader : Retourne l'index pointant sur l'entrée correspondant
#                    à la ligne de l'entête
########################################################################
# [Entrée]  $ListeMsg : liste contenant le message (une ligne par entrée)
#       $ChampEntetes : nom de l'entête incluant les ":"
# [Sortie] (résultat) : index, -1 si non trouvé
# Exemple : $HdrIdx = MsgIndexOfHeader( $ListeMsg, "From:" )

sub MsgIndexOfHeader( $ListeMsg, $ChampEntetes )

   var( $i, $Idx )
   
   $Idx = -1
   $i = 0

   while( $i < ListCount( $ListeMsg )  )
      break( ListGet( $ListeMsg, $i ) = "" ) # Fin des entêtes

      if( $ChampEntetes = MsgHeadernameOfIndex( $ListeMsg, $i ) )
         $Idx = $i
         break
      endif

      inc( $i )
   endwhile
   
   return( $Idx )
   
endsub

########################################################################
# MsgGetHeader: Retourne le contenu d'un champ d'entête
########################################################################
# [Entrée]  $ListeMsg : liste contenant le message (une ligne par entrée)
#       $ChampEntetes : nom de l'entête incluant les ":"
# [Sortie] (résultat) : contenu du champ d'entête, "" si non trouvé.
# Exemple: $Contenu_Champ_entetes = MsgGetHeader( $ListeMsg, "From:" )

sub MsgGetHeader( $ListeMsg, $ChampEntetes )
   var( $Contenu_Champ_entetes, $Idx, $i, $s )
   
   # Cherche la position du champ d'entête
   $Idx = MsgIndexOfHeader( $ListeMsg, $ChampEntetes )

   # Si trouvé, retourne le contenu du champ d'entête
   if( $Idx >= 0 )
      $Contenu_Champ_entetes = ListGet( $ListeMsg, $Idx )
      $i = Pos( ":", $Contenu_Champ_entetes )
      $Contenu_Champ_entetes = iif( $i=0, "", copy($Contenu_Champ_entetes,$i+1) )
      $s = copy( $Contenu_Champ_entetes, 1, 1 )
      if( Pos($s,$WSP) > 0 )
         $Contenu_Champ_entetes = Delete( $Contenu_Champ_entetes, 1, 1 )
      endif
      
      # append continuation lines separated by CR+LF
      do
         inc( $Idx )
         $s = copy( ListGet( $ListeMsg, $Idx ), 1, 1 )
         break( Pos($s,$WSP)=0 ) # 1st char=WSP?
         $Contenu_Champ_entetes = $Contenu_Champ_entetes + $CRLF + ListGet( $ListeMsg, $Idx )
      loop
   else
      $Contenu_Champ_entetes = ""
   endif

   # Retourne le contenu du champ d'entête (i.e. n'incluant pas le nom du
   # champ d'entête)   
   return( $Contenu_Champ_entetes )
   
endsub

########################################################################
# MsgAddHeader: Ajoute une ligne d'entêtes même si le message contient 
#               déjà une ligne avec le même champs.
#               (Voir aussi : MsgSetHeader)
########################################################################
# [Entrée]  $ListeMsg : liste contenant le message (une ligne par entrée)
#           $ChampEntetes : nom de l'entête incluant les ":"
#           $Contenu_Champ_entêtes: contenu du champ d'entêtes.
# [Sortie] : index de la nouvelle ligne d'entête, -1 en cas d'erreur
# Exemple: $AddIdx = MsgAddHeader( $ListeMsg, "X-I-Like-X-Headers:", "No" )

sub MsgAddHeader( $ListeMsg, $ChampEntetes, $Contenu_Champ_entetes )
   var( $i, $Idx )
   
   # Trouve la ligne vide séparant les entêtes du corps
   $Idx = ListIndexOf( $ListeMsg, "" ) 

   # S'il est manquant, rajouter la ligne vide séparant les entêtes du corps
   if( $Idx < 0 )
      ListInsert( $ListeMsg, 0, "" ) 
      $Idx = 0
   endif
   
   # ajoute la ligne d'entêtes juste avant la ligne vide séparant
   # les entêtes du corps
   ListInsert( $ListeMsg, $Idx, $ChampEntetes + " " + $Contenu_Champ_entetes )
   
   # retourne la postion de la nouvelle ligne d'entête
   return( $Idx )
   
endsub

#######################################################################