provide rrouter

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

: ${UNRESOLVABLEACTION:='error unresolvable'}

rrouter (address, A) {
	local tmp tee seenuucp seenbitnet
	seenuucp=false; seenbitnet=false

	sift "$address" in
	# first make canonical
	(.*)<(.*)
		address="\1\2\3" ;;		# defocus
	(.*)>(.*)
		address="\1\2\3" ;;		# defocus
	.*
		address=$(canonicalize "$address") ;;
	<in%>(.*)
		return (((error vms-in-pros "in%\1" $A))) ;;
	(.*)<@(.+)\.uucp>(.*)
		seenuucp=true
		address="\1<@\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.....
	#\\(.)	return (((local - "$address" $A))) ;;
	@	# handle <> form ???
		return $(routeuser $(list local - postmaster $A)) ;;
	#(.*)<@\[(.)\]>(.*)
	#	address="\1<@$(gethostbyaddr \2)>\3"
	#	;;
	(.*)<@\[(.)\]>(.*)
		# numeric internet spec
		return (((smtp "[\2]" "\1@$(gethostbyaddr \2)\3" $A))) ;;
	(.*)<@(.*)\.>(.*)
		address="\1<@\2>\3" ;;

	# now massage the local info
	(.*)<@(.*)($orgdomains)>(.*)
		address="\1<@\2$orgdomain>\4" ;;
	<@($orgdomains)>[:,](.+@.+)
		return $(rrouter "\2" $A) ;;	# strip organization
	(.*)<@(.+)>(.*)
		if [ $(deliver "\2") ]; then
			address="\1<@>\3"
		elif [ \2 = $hostname ]; then
			address="\1<@>\3"
		fi ;;
	<@>.(.*)
		return $(rrouter "\1" $A) ;;	# try after route strip
	(.*)<@>	
		return $(rrouter "\1" $A) ;;	# strip trash & retry
	tfis

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

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

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

		if [ x$seenbitnet = xtrue ]; then
			address="\1@\2.bitnet"
		fi

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

		if [ x$seenuucp = xtrue ]; then
			if [ "$UUCPACTION" != "" ]; then
				return ((($UUCPACTION "\1@\2.uucp" $A)))
			fi
			tmp=$(routes_neighbour "\2.uucp" "$address" $A) &&
				return $tmp
		fi

		if [ x$seenbitnet = xtrue ]; then
			if [ "$BITNETACTION" != "" ]; then
				return ((($BITNETACTION "\1@\2.BITNET" $A)))
			fi
		fi


		if [ "$SMARTHOST" ]; then
			return $(rrouter "$SMARTHOST!$(uucproute "$address")" $A)
		else
			return ((($UNRESOLVABLEACTION "$address" $A)))
		fi
		;;

	[/|].+	# file or pipe
		return (((local - "$address" $A)))
		;;
	[^.:](\.[^.])+
		if [ $(fullnamemap "$address") ]; then
			return $(rrouter $(fullnamemap "$address") $A)
		fi
		if [ $(newsgroup "$address") ]; then
			return (((usenet - "$address" $A)))
		fi
		return (((error norealname "$address" $A)))
		return (((error nonewsgroup "$address" $A)))
		;;
	.*	return $(routeuser $(list local - "$address" $A))
		;;
	tfis
}	# end of rrouter

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

	sift "$domain" in
#	(bsmtp3|bitnet2|bitnet2deliver2)!(.)!(.)
	(bsmtp3|bsmtp3truncate|bitnet2|bitnet2deliver2)!(.)!(.)
		return (((\1 "\2@\3" "$address" $A))) ;;
	(defrt1|defrt1truncate)!(.)
		channel=\1
		rscshost=\2

		tmp="$(uucproute "$address")"
		sift "$tmp" in
		.+!([^!]+)!([^!]+)
			# we are trying to gateway through a DEFRT1 domain(!)
			#return (((error bitnetgw "$address" $A))) ;;
			# usually this will work anyway, sigh...
			return (((bsmtp3 "mailer@$rscshost" "\2@\1" $A))) ;;
		([^!]+)!([^!]+)
			# destination domain is next hop, so we're all happy
			return ((($channel "\2@$rscshost" "\2@\1" $A))) ;;
		tfis
		;;
	ignore!.*
		break ;;
	(.?)!
		return ((("\1" - "$address" $A))) ;;
	delay!(.)
		# NB! envelopeinfo *must* also be defined in interactive mode
		tmp="$(/bin/expr $(get envelopeinfo now) + "\1")"
		return (((hold "$tmp" "$address" $A))) ;;
	(.?)!([^!]+)
		return ((("\1" "\2" "$address" $A))) ;;
	(.?)!(.+)
		# BEWARE LOOPS
		return $(rrouter "\2!$(uucproute "$address")" $A) ;;
	tfis
	return 1
}

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.

	sift "$address" in
	(.*)<(.*)>(.*)		address=\1\2\3 ;;		# defocus
	(.+!)@(.+)		address=\1$(uucproute "@\2") ;;
	(.+)([,:]@)(.+)		address=\1!\3 ; continue ;;
	:include:[^!]+		return $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 ;;
	tfis
	return "$address"
}	# end of uucproute
