#
#  rrouter.cf -- most of the address routing processing is done here..
#


provide rrouter

. fqdnalias.cf # Pick that set of tools into here!

envelopeinfo=(message-id "<$USER.interactive@$hostname>" now 0)

: ${UNRESOLVABLEACTION:='error unresolvable'}

relation -bt selfmatch selfmatch

rrouter (address, origaddr, A, plustail, domain) {
	local tmp tee didhostexpand priv nattr a
	# local seenuucp seenbitnet
	# seenuucp=false
	# seenbitnet=false
	didhostexpand="";
# echo "rrouter: address=$address, origaddr=$origaddr" >> /dev/tty

	tmp=$(fqdn_neighbour "$origaddr" "$address" $A) &&
		returns $tmp

	#address="$(condquote -- "$address")"

	#
	# We have troublesome addresses coming here...
	#	"|pipe-program"
	#	"|quoted string"@domain
	#	"foo > faa"@domain
	#	"fii < fuu"@domain
	#	"foo @ faa"@domain
	#	"|foo @ faa"
	# and we want to do correct focusing..
	#

	ssift "$address" in
	# Now make canonical
	'"'(.*)'"'<(.*)
		address="\1\2"			# defocus
		;;
	'"'(.*)'"'>(.*)
		address="\1\2"			# defocus
		break ;;
	([\'"'].*[\'"'])<(.*)
		address="\1\2" ;;		# defocus
	([\'"'].*[\'"'])>(.*)
		address="\1\2" ;;		# defocus
	# See that it does not start with a pipe ...
#	\|.+	# Looks like a pipe... Don't mutilate it!
#		break ;;
#	'"'[|].+	# Quoted pipe ??   What the ... ??
#		break ;;
	tfiss

	address=$(canonicalize "$address")

	ssift "$address" in
	<@\[([A-Za-z0-9]+)\]>:(.+)@(.+)
		# VERY MAGICAL:  @[channelname]:user@domain
		returns ((("\1" "\3" "\2$plustail@\3" $A)))
		;;
	#<@\[([A-Za-z0-9]+)\]>:(.+)@(.+)
	<@\[(.+)\]>:(.+)@(.+)
		# QUITE MAGICAL:  @[CHANNEL:IPLITERAL]:user@domain
		returns ((("smtpx" "[\1]" "\2$plustail@\3" $A)))
		;;
	tfiss

	tsift "$address" in
#	<in%>(.*)
#		returns (((error vms-in-pros "in%\1" $A))) ;;
#	(.*)<@(.+)\.uucp>(.*)
#		seenuucp=true
#		address="\1$plustail<@\2>\3" ;;		# fix host.uucp!route
#	(.*)<@(.+)\.(bitnet|earn|netnorth)>(.*)
#		seenbitnet=true		# Strip off the (bitnet|netnorth|earn)
#		address="\1<@\2>\4" ;;		# fix host.bitnet!route
#	 handle special cases.....
#	\\(.+)	returns (((local - "$address" $A))) ;;
	@	# handle <> form ???
		if [ "z$(get $A type)" = zsender ]; then
			tmp=(error user postmaster $A)
		else
			tmp=(local user postmaster $A)
		fi
		tmp=$(routeuser $tmp "$plustail" "") && returns $tmp
		return $tmp # error code return
		;;

## -----------------------------------------------------------------
## Following two are two approaces to the same problem, generally
## speaking we should use the SECOND one, but your mileage may vary..
## (Problems exist when WE are the target, and also a part of some
##  high reliability set of hosts, any of which can take the roles
##  of any other host -- all fine if also local email processing is
##  symmetric, else catching peer's IP address may accept email that
##  is not really destined to ourself..)
#
#	(.*)<@\[(.+)\]>(.*)
#		address="\1$plustail<@$(gethostbyaddr \2)>\3"
#		;;
	(.*)<@\[(.+)\]>(.*)
		# numeric internet spec
		if $(selfmatch "\2") ; then
			address="\1$plustail<@>\3"
			domain="@[\2]"
			plustail=""
		else
			returns (((smtp "[\2]" "\1$plustail@$(gethostbyaddr \2)\3" $A)))
		fi
		;;
## end of [1.2.3.4] address case..
## -----------------------------------------------------------------

	(.*)<@(.*)\.>(.*)
		address="\1$plustail<@\2>\3"
		plustail=""
		;;

	# now massage the local info
	(.*)<@(.*)($orgdomains)>(.*)
		address="\1$plustail<@\2$orgdomain>\4"
		domain="@\2$orgdomain"
		plustail=""
		;;
	<@(.*)>[:,](.+)@(.+)
		if tmp=$(deliver "\1") ; then # Source routed to our name ?
			tmp=$(rrouter "\2$plustail@\3" "$origaddr" $A "" "") \
				&& returns $tmp
			return $tmp # error code return
		fi
		;;
	<@($orgdomains)>[:,](.+)@(.+)
		tmp=$(rrouter "\2$plustail@\3" "$origaddr" $A "" "") && \
			returns $tmp
		return $tmp # error code return
		;;	# strip organization
	(.+)<@(.+)>(.*)
		# Ok, lets see if it is LOCAL hostname.
		# This recase is needed to handle testing against
		# $hostname variable content, which is supposedly
		# lowercase name.
		tmp="$(recase -l -- "\2")"
		if tee=$(deliver "$tmp") ; then	# Do we handle this ?
			address="\1$plustail<@>\3"
			domain="@\2"
			plustail=""
		elif [ "z$tmp" = "z$hostname" ]; then # Is it at local host ?
			address="\1$plustail<@>\3" # (this is a backup test)
			domain="@\2"
			plustail=""
		fi ;;
	<@>.(.+)	# This plustail is probably wrong...
		# try after route strip
		tmp=$(rrouter "\1$plustail" "$origaddr" $A "" "$domain") && \
			returns $tmp
		return $tmp # error code return
		;;
	(.+)<@>	
		if [ -z "$domain" ]; then
			domain="$mydomain"
		fi
		tmp=$(rrouter "\1$plustail" "$origaddr" $A "" "$domain") && \
			returns $tmp
		return $mp # error code return
		;;	# strip trash & retry
	tfist

#log "BITNET name=$bitnetname, address=$address"
#	case $bitnetname in
#	?*)	tsift "$address" in
#		(.*)<@(.*)\.(bitnet|netnorth|earn)>(.*)
#			address="\1<@\2>\4" ;;
#			# Strip off the (bitnet|netnorth|earn)
#		tfist
#		;;
#	esac
#log "BITNET name=$bitnetname, address=$address"

	# resolve names to routes, get actual channel
	# name mostly from external database

	tsift "$address" in
	(.*)<@(.+)>(.*)	
#log "neighbourg test: domain: \2, addr: $address"
		address="\1$plustail@\2\3"
		plustail=""


		#if [ "z$seenbitnet" = ztrue ]; then
		#	address="\1@\2.bitnet"
		#fi

		didhostexpand=$(hostexpansions "\2")

		for method in $(elements $protocols)
		do
		   	tmp=$("${method}_neighbour" "\2" "$address" $A) &&
				returns $tmp
		done

		#if [ "z$seenuucp" = ztrue ]; then
		#	if [ "$UUCPACTION" != "" ]; then
		#		returns ((($UUCPACTION "\1@\2.uucp" $A)))
		#	fi
		#	tmp=$(routes_neighbour "\2.uucp" "$address" $A) &&
		#		returns $tmp
		#fi

		#if [ "z$seenbitnet" = ztrue ]; then
		#	if [ "$BITNETACTION" != "" ]; then
		#		returns ((($BITNETACTION "\1@\2.BITNET" $A)))
		#	fi
		#fi


		returns ((($UNRESOLVABLEACTION "$address" $A)))
		;;
	tfist

	# Ok, possible LOCAL things must be matched dequoted here!

	tmp="$(dequote -- "$address")"
	ssift "$tmp" in
	\\(.+)	# A back-quote prefixed userid (most likely)
		##tmp=$(rrouter "\1" "$origaddr" $A "$plustail" "") &&
		##   returns $tmp
		##return $tmp  # error code return
		tmp=(local "$origaddr" "$address" $A)
		tmp=$(routeuser $tmp "$plustail" "") && returns $tmp
		return $tmp # error code return
		;;

	/.+	# file
		# -- well, it could be a slash-notated X.400 address too..
		returns (((local "file.$origaddr" "$address" $A)))
		;;
	\|.+	# pipe
		returns (((local "pipe.$origaddr" "$address" $A)))
		;;
	:include:.+ # ":include:" -alias
		# We must test this here, because the file-path after
		# this prefix may have a dot!
		tmp=(local "$origaddr" "$address" $A)
		tmp=$(routeuser $tmp "$plustail" "") && returns $tmp
		return $tmp # error code return
		;;
	(.+)::(.+) # node1::(rest) -- DECNET Phase-IV
		returns (decnet "\1" "\2" $A)
		;;
	# Ok, from now on if we don't have a domain set, we use $mydomain
	.*	if [ -z "$domain" ] ; then
			domain="@$mydomain"
		fi
		;;
	tfiss

# ------- begin new "localpart" processing

	tmp=(local "$origaddr" "$address" $A)
	tmp=$(routeuser $tmp "$plustail" "$domain") && returns $tmp
	return $tmp # error code return

# ------- end new "localpart" processing
}	# end of rrouter

routes_spec (rtedata, address, A) {
	local tmp channel rscshost

	ssift "$rtedata" in
#	(bsmtp3nd|bsmtp3|bitnet2|bitnet2deliver2)!(.+)!(.+)
	(bsmtp3nd|bsmtp3|bsmtp3rfc|bsmtp3ndrfc)!(.+)!(.+)
		returns ((("\1" "\2@\3" "$address" $A))) ;;
	(defrt1)!(.+)
		channel="\1"
		rscshost="\2"

		tmp="$(uucproute "$address")"
		tsift "$tmp" in
		.+!([^!]+)!([^!]+)
			# we are trying to gateway through a DEFRT1 rtedata(!)
			#returns (((error bitnetgw "$address" $A))) ;;
			# usually this will work anyway, sigh...
			returns (((bsmtp3 "mailer@$rscshost" "\2@\1" $A))) ;;
		([^!]+)!([^!]+)
			# destination rtedata is next hop, so we're all happy
			returns ((($channel "\2@$rscshost" "\2@\1" $A))) ;;
		tfist
		;;
	ignore!.*
		break
		;;
	(smtpgw.*)!
		tmp="\1"
		tsift "$address" in
		(.*)@(.+)
			returns ((("$tmp" "\1" "$address" $A)))
			;;
		tfist
		;;
	(smtp.*)!
		tmp="\1"
		tsift "$address" in
		(.*)@(.+)
			returns ((("$tmp" "\2" "$address" $A)))
			;;
		tfist
		;;
	dns!
		tsift "$address" in
		(.*)@(.+)
			returns (((smtp "\2" "$address" $A)))
			;;
		tfist
		;;
	(.+)!
		returns ((("\1" - "$address" $A)))
		;;
	lotusgw!(.+)!(.+)
		# Map user@domain to user%gwdom@gateway
		tmp="\1"; channel="\2" # Variable name reuse..
		tsift "$address" in
		(.+)@(.+)
			returns (((smtp "$channel" "\1%$tmp@$channel" $A)))
			;;
		tfist
		;;
	delay!(.+)
		# NB! envelopeinfo *must* also be defined in interactive mode
		tmp="$(/bin/expr $(get envelopeinfo now) + "\1")"
		returns (((hold "$tmp" "$address" $A))) ;;
	(.+)!([^!]+)
		returns ((("\1" "\2" "$address" $A))) ;;
	(.+)!(.+)
		# BEWARE LOOPS
		tmp=$(rrouter "\2!$(uucproute "$address")" "$address" $A "" "$rtedata") && \
			returns $tmp
		return $tmp # error code return
		;;
	tfiss
	return 1 # error code return
}

uucproute (address) {

#| This function turns any address into a pure-! form.  It should not
#| call any other functions, since random other functions call it.
#| In particular it should not use rfc822route which itself uses
#| uucproute.

	tsift "$address" in
	(.*)<(.*)>(.*)		address=\1\2\3 ;;		# defocus
	(.+!)@(.+)		address=\1$(uucproute "@\2") ;;
	(.+)([,:]@)(.+)		address=\1!\3 ; continue ;;
	:include:[^!]+		returns "$address" ;;
	@(.+:)([^:]+)		address=\1$(uucproute "\2") ;;
	(.+):(.+)		address=\1!\2 ; continue ;;
	# This won't work properly for e.g. utzoo!bar@gpu.utcs.toronto.edu
	# because gpu.utcs also has an active uucp connection with utzoo. Argh.
	# It will work properly in other cases though, so if we have to guess...
	#([^!])!(.+)@(.+)	if [ $(ldotsys \1) ]; then
	#				address=\1!\3!\2
	#			else
	#				address=\3!\1!\2
	#			fi ;;
	(.+)!([^!]+)%([^!%]+)@(.+)	# route!a%b@c -> route!c!a@b
				address=\1!\4!\2@\3 ; continue ;;
	([^@]+)@(.+)		address=\2!\1 ;;
	@(.+)			address=\1 ;;
	(.+)!([^!]+)[%@](.+)	address=\1!\3!\2 ;;
	tfist
	returns "$address"
}	# end of uucproute
