provide crossbar

# The crossbar function makes the policy decisions of how the instance of
# a message between a particular sender and recipient should be treated.
# The 'from' and 'to' parameters are quads, i.e., in the form
#
#	(channel host user attributes)
#
# The function may modify any of these elements of both the from and to
# addresses, and must select a message header address rewriting function
# to be applied to this message instance.  If the return value is nil or
# empty, the instance is completely ignored, to the point that if there are
# no other recipients specified a complaint will be generated saying there
# are *no* recipients specified.

crossbar (from, to) {
	local rewrite destination tmp

	# Intercept (drop, redirect, bounce, save) the message

	tmp=$(intercept "$(user $from)") &&
		case "$(car $tmp)" in
		# dropping error types for from addresses is necessary to
		# avoid mail loops
		drop|error)
			return ;;
		file)	LOGMSG="$LOGMSG $(car $(cdr $tmp))" ;;
		esac

	# Only intercept mail that is not from the local postmaster,
	# so that error messages can find their way back.

	[ "$(channel $from)" = local -a "$(user $from)" = postmaster ] ||
	tmp=$(intercept "$(user $to)") &&
		case "$(car $tmp)" in
		drop)	return ;;
		error)	setf $(channel $to) error
			setf $(host $to) $(car $(cdr $tmp))
			;;
		file)	LOGMSG="$LOGMSG $(car $(cdr $tmp))" ;;
		esac

	# If we do any alias expansion from the crossbar, we should do this:
	#db flush expansions

	# Determine which rewrite function (for message header addresses) to use

	case $(channel $to) in
	smtp)	case "$(channel $from)" in
		smtp)	# addresses should be forwarded the way they arrive
			rewrite=null ;;
		*)	rewrite=internet ;;
		esac
		;;
	error)	rewrite=null ;;
	local)	case "$(channel $from)" in
		local)	#rewrite=intramachine ;;
			rewrite=internet ;;
		*)	# addresses should be saved the way they arrive
			rewrite=null ;;
		esac
		;;
	usenet)	rewrite=internet ;;
	ean)	rewrite=ean_useratdomain ;;
	*)	# This is usually UUCP or BITNET
		# We want to determine the final destination host/domain
		destination=$(uucproute "$(user $to)")
		if [ $(host $to) ]; then
			destination=$(host $to)!$destination
		fi
		sift $destination in
		.*!([^!]+)![^!]+
			destination=\1 ;;	# destination domain
		.*\.(bitnet|netnorth|earn|cdn)
			rewrite=smtp_useratdomain
			break ;;			# reply to user@domain
		.*	rewrite=internet ; break ;;	# default sensible thing
		tfis
		;;
	esac

	# The alias expansion might want to modify the envelope sender
	# of the message instance.  Here we cooperate in the scheme which
	# is to set the 'sender' attribute of the destination address.

	tmp="$(get $(attributes $to) sender)" && [ x"$tmp" != x ] &&
		from=(local - "$tmp" $(attributes $from))


	case "$(channel $from)" in
	defrt1*|bitnet2*|bsmtp3*)
		setf "$(user $from)" "$(bitnetroute "$(user $from)")"
		if [ $rewrite = internet ]; then
			rewrite=bitnet2internet
		fi
		;;
	esac

	# Rewrite the envelope addresses appropriately

	case "$(channel $to)" in
	uucp|local)
		# Local destination on a system that delivers in UCB Mail
		# compatible mail spool files means that the From_ line
		# must be in all-! form, which is the same as the UUCP
		# transport requirement.

		setf "$(user $from)" "$(uucproute "$(user $from)")"
		setf "$(user $to)" "$(uucproute "$(user $to)")"
		sift "$(user $to)" in
		(.)!(.*)	if [ \1 = $(host $to) ]; then
					setf "$(user $to)" \2
				fi
				;;
		tfis
		sift "$(user $to)" in
		(.)\.uucp!(.*)	setf "$(user $to)" \1!\2 ;;
		tfis
		;;
	#local)
	#	tmp="$(smtproute "$(user $from)")"
	#	sift "$tmp" in
	#	@(.+):(.+:.+)
	#		tmp="@\1,\2" ; continue ;;
	#	(@$hostname[:,].*)|([^@:,]+@$hostname)
	#		break ;;
	#	.*
	#		# tmp="@$hostname:$tmp"  # DON'T !
	#		;;
	#	tfis
	#	setf "$(user $from)" "$tmp"
	#	tmp="$(user $to)"
	#	sift "$tmp" in
	#	.*	tmp="$(smtproute "$tmp")" ;;
	#	\"[|/].*	tmp="$(user $to)" ;;
	#	[|/].*		tmp="$(user $to)" ;;
	#	tfis
	#	setf "$(user $to)" "$tmp"
	#	;;
	smtp)
		tmp="$(smtproute "$(user $from)")"
		sift "$tmp" in
		(@$hostname[:,].*)|([^@:,]+@$hostname)
			break ;;
		.*
			# tmp="@$hostname:$tmp"  # DON'T !
			;;
		@(.+):(.+:.+)
			tmp="@\1,\2" ; continue ;;
		tfis
		setf "$(user $from)" "$tmp"
		setf "$(user $to)" "$(smtproute "$(user $to)")"
		;;
	ean)	
		setf $(user $from) "$(ean_useratdomain "$(user $from)")"
		setf "$(user $to)" "$(ean_useratdomain "$(user $to)")"
		;;
	usenet)
		setf $(user $from) "$(uucproute "$(user $from)")"
		sift $(user $from) in
		$hostname!.*	;;
		.*	setf $(user $from) $hostname!$(user $from) ;;
		tfis
		# newsgroup name only
		setf "$(user $to)" $(localpart "$(user $to)")
		;;
	bsmtp3)
		setf $(user $from) "$(bitnetroute "$(user $from)")"
		tmp="$(bitnetroute "$(user $to)")"
		sift "$tmp" in
		.*@([^.]).uucp
			tmp="$(bitnetShortroute "$(user $to)")" ;;
		tfis
		setf "$(user $to)" "$tmp"
		rewrite=bitnetShortroute
		;;
	bitnet2|bitnet2deliver2)
		setf $(user $from) "$(bitnetroute "$(user $from)")"
		setf $(user $to) "$(bitnetroute "$(user $to)")"
		rewrite=bitnetroute
		;;
	defrt1|defrt1truncate)
		setf $(user $from) "$(bitnetroute "$(user $from)")"
		setf $(user $to) "$(bitnetroute "$(user $to)")"
		rewrite=bitnetroute
		sift "$(user $to)" in
		(.*)[!%](.+)@(.*)
			to=(error bitnetgw "\3" $(attributes $to))
			rewrite=null
			;;
		tfis
		;;
	esac

	log recipient: "$(channel $to)" "$(host $to)" "$(user $to)"

	return ($rewrite "$from" "$to")

}	# end of crossbar

# If you want to intercept specific mail messages, this function and the
# associated code in the crossbar and process functions will let you do it.  
# There are three possible actions:
#
#	drop		- completely ignore this address
#	error		- return the specified error message
#	file		- append the message file to the specified file
#
# Both the file and error actions require an argument, which necessitates
# the use of multiple-value return (i.e., return a list) in all cases.
#
# If you don't want to intercept anything, this function should return failure.
# The stub defined here is the usual case, you can override it in the host-
# specific cf file.

intercept (address) {
#	case "$(smtp_useratdomain "$address")" in
#	*@pdq*)		return (file /var/scr/pdq) ;;
#	rayan@csri.*)	return (drop) ;;
#	bitftp*@*)	return (error bounce) ;;
#	esac

	return 1
}

# On mail from one local user to another, we don't want to see all the
# long domain name extensions.  This *can* cause problems with silly UAs,
# if it does you can just redefine 'intramachine' to call 'null' in your
# site or host-specific configuration files.

intramachine (address) {		# strip hostname if it came from here
	sift "$address" in
	[|/].*	return "$address" ;;
	#(.*)@($hostname|$mydomain)
	#	address="\1" ;;
	(.*)@($hostname|$mydomain)
		address="\1@${mydomain}" ;;
	tfis
	return "$address"
}	# end of intramachine


null (address) {
	return "$address"		# surprise!
}

# This is usually the default message-header address rewriting function.
# It is responsible for hostname hiding and qualification.

internet (address) {
	address=$(canonicalize "$address")
	#echo "address=$address";
	sift "$address" in
	(.*)<@(.+)>(.*)	if [ $(deliver \2) ]; then	# hostname hiding
				address="\1@${mydomain}\3"
				break
			fi
			;;
	(.*)<(.+)>(.*)	address="\1\2\3" ;;		# defocus
	[^@]+		address="$address@$mydomain" ;;	# add our hostname
	tfis
	return "$address"
}	# end of internet
