# Expansion of the local-part of a locally delivered address is done here.
#
# We check (in order):
#
#	$FORCEPUNT -- if defined, route to: user@$FORCEPUNT
#	":include:" or "|" or "/" prefix
#	aliases file entry (mapping to a list of addresses)
#	mboxmap file entry (mapping to a host!homedir!user value)
#	$MAILVAR/lists directory entry (mapping to a list of addresses)
#	-request or -owner suffix (mapping to owner of mailing list file)
#	$PUNTHOST (mapping to user@$PUNTHOST)
#	$forward  file entry (mapping to a list of addresses)
#
# If we get all the way through, we give up.  Note that if PUNTHOST is
# defined, then the mboxmap mechanism should be used to ensure local delivery
# for local users.

provide aliases

#
# Define the 'Sendmail-like' aliases database
# 

if [ -f $MAILVAR/db/aliases.zmsh ]; then

    # If that file exists, it contains scripts defining our databases
    # at load-in time (relation entries), and also runtime callable
    # entrypoint  aliases(uname) { ... }  which "return 1" in case no
    # lookup succeeds.  It yields the first lookup result that succeeded.
    # Also, successfull lookup must yield file privileges of the database
    # file where the lookup was done.  The return is done to a "priv"
    # variable which has local scope in the caller's symbol stack.

    . $MAILVAR/db/aliases.zmsh

else
    if [ -f $MAILVAR/db/aliases ]; then
	# Need to be updated at boot ?
	if [ ! -f $MAILVAR/db/aliases$DBEXTtest -o \
	     $MAILVAR/db/aliases -nt $MAILVAR/db/aliases$DBEXTtest ]; then
		# Yes, so update!
		$MAILBIN/newdb -l -a $MAILVAR/db/aliases
	fi
# ---- raw relation entry
	relation -lmt $DBTYPE -f $MAILVAR/db/aliases$DBEXT aliasesdb
# ---- interface function
	aliases(key) {
		local a
		if a="$(aliasesdb "$key")"; then
		  priv="$(filepriv -M 644 $MAILVAR/db/aliases$DBEXTtest \
					$(db owner aliasesdb))" &&
		  return "$a"
		fi
		return 1
	}
    else
	aliases () { return 1 }
    fi
fi

# If the 'm' option was NOT specified on the aliases relation,
# presumably whatever creates new aliases will poke us (using SIGURG).

trap "db flush aliasesdb ; log flushed aliases" 16


#
# Safeguard if fullnamemapdb() is not yet created (as part of aliases()?)
#
case "$(type fullnamemapdb)" in
*"not found")

    # optional: Fullname database: <Full_Name>    <login>

    if [ -f $MAILVAR/db/fullnames$DBEXTtest  ]; then
	relation -lmt $DBTYPE -f $MAILVAR/db/fullnames$DBEXT fullnamemapdb
	fullnamemap (key) {
	    local a;
	    if a="$(fullnamemapdb "$key")" ; then
		# "priv" analysis ???
		return "$a"
	    fi
	    return 1
	}
    else
	fullnamemap () { return 1 }
    fi

    ;;

*)  # Can be found!
    case "$(type fullnamemap)" in
    *"not found")
	# The DB is there, but not this function, propably as a part of
	# aliases() database call entry...
	fullnamemap() { return 1 }
	;;
    esac
    ;;
esac



# If an mboxmap file exists, only users specified in the mboxmap are
# recognized, and we want to deliver to them on the host, home directory
# filesystem, and filename, specified as the value in the mboxmap DB.
# The key->value mapping looks like this:
#	<name> <$hostname:$MAILBOX:$name>
# The mboxmap file is in MAILSHARE because it is identical for all machines
# in the cluster.

if [ -f $MAILSHARE/db/mboxmap$DBEXTtest ]; then
	relation -lmt $DBTYPE -f $MAILSHARE/db/mboxmap$DBEXT mboxmap
	POBOX=PObox	# becomes $HOME/../PObox/$USER
else
	mboxmap () { return 1 }
	POBOX=''
fi

#
# Map containing accounts that have expired, we return
# a special error report on them.
#
if [ -f $MAILVAR/db/expiredaccts$DBEXTtest ]; then
       relation -lmt $DBTYPE -f $MAILVAR/db/expiredaccts$DBEXT expired
else
       expired () { return 1 }
fi



# Usage: routeuser (channel host user attributes)
#
# This is where local alias expansion is controlled.

routeuser (quad, plustail, domain) {
	local chan user host lcuser mxh al a l
	local key attr pobox didexpand nattr homedir
	local plustail2 forward priv hashomedir

	plustail2=""
	attr="$(attributes $quad)"
	chan="$(channel $quad)"
	
	case "$(get $attr type)" in
	sender)	return (($quad)) ;;
	esac

	# get rid of the attribute tag for alias loop prevention
	a=$quad
	#mxh=$(setf $(last $a) ())

	# For the expansions control tag we can use only
	# the 'channel',  and the 'username' strings, we CAN'T
	# use 'attributes' element, because .forward recursion
	# will have subsequently DIFFERENT values for it.
	# Use of 'host' field means we can't use 

	user="$(user $quad)"
	key="$chan$(host $quad)$user"
	didexpand=$(expansions "$key")

	[ -n "$didexpand" ] &&
	case "$didexpand" in
	user)	# Looping thru  .forward  will cause us to call back
		# into here :-(
		;;
	*)	
		# Sigh, the easiest way to handle duplicate invokations
		# in here is to yield "bitbucket".  In theory we could
		# yield (), but the router dislikes it.  (Must teach
		# it for good manners..)
		return (((bitbucket "$(host $quad)1" "$(user $quad)" $(attributes $quad))))
		;;
	esac

	al=()

	case "$(channel $quad)" in
	#smtp)	mxh=$(mxhosts $(host $quad).)
	#	user="$(user $quad)"
	#	attr="$(attributes $quad)"
	#	case $#mxh in
	#	[1-9]*)	# make the XOR list
	#		for host in $(elements $mxh)
	#		do
	#			case $#al in
	#			0)	al=$(rrouter "$address" "$address" $attr "" "") ;;
	#			*)	set $(cdr $(last $al)) \
	#				    (((smtp "$host" "$user" $attr))) ;;
	#			esac
	#		done
	#		return $al
	#		#a=((x) (smtp '$x' "$(user $quad)" $attr))
	#		#mapcar $a $mxhosts
	#		;;
	#	esac
	#	;;
	local)	;;	# this is the normal case, below
	*)	return (($quad))
		;;
	esac

	user="$(condquote "$(user $quad)")"
	host="$(condquote "$(host $quad)")"

# echo "routeuser: host=$host, user=$user" >> /dev/tty

	[ -n "$FORCEPUNT" ] &&
		return $(rrouter "$user@$FORCEPUNT" "$host" $attr "" "")

	ssift "$user" in
	\\(.*)	user="\1" # Back-quoted username -- most likely
		didexpand=local
		;;
	:include:(.+)
		db add expansions "$key" file
		priv=$(get $attr privilege)
		[ -f "\1" ] &&
		 priv=$(getpriv "644" $priv "\1" include) &&
		  nattr=$(newattribute $attr privilege $priv) &&
		   defer=''
		return $(listexpand -E "postmaster" -e root -p $priv	\
				    -c ":include:\1 file expansion"	\
				    "$nattr" "\1" "$host" "" "$domain" < "\1")
		;;

#	# This following requires ZM 2.99.46+ shell language!
#	# The single/double quotes are paired, and ignored while
#	# scanning the selector pattern.  If a quote is needed,
#	# try following mapping:
#	# left is input, right is result:  '"pat'"'" -> "pat'
#	# That is, to produce a double quote, code: '"',
#	# and for single quote, code: "'"
#	# Here we have SPACE and TAB in this pattern!
#	'[^"]*[ 	][^"]*'
#		# If the $user had no quotes on it, we add them here!
#		if [ "$(dequote "$user")" = "$user" ]; then
#			user="\"$user\""
#		fi
#		;;
	[|/].*	return (($quad))
		;;
	tfiss

#	alias expansion
	#[ -z "$didexpand" ] && a="$(aliases "$user")" &&
	#	db add expansions "$key" alias &&
	#	priv=$(filepriv -M 644 $MAILVAR/db/aliases \
	#				$(db owner aliases)) &&
	#	nattr=$(newattribute $attr privilege $priv) &&
	#	...
	if [ -z "$didexpand" ] && a="$(aliases "$user")" ; then
		db add expansions "$key" alias
		nattr=$(newattribute $attr privilege $priv)

		return $(echo "$a" |			\
			 listaddresses	-E "root"	\
					-e "root"	\
					-c "$user file expansion" | \
			maprrouter $nattr "$user" "$host" \
					 "$plustail" "$domain")

	fi

# ---- from rrouter.cf:

	if a="$(fullnamemap "$user")" ; then
		return $(rrouter "$a" "$user" $attr "$plustail" "$domain")
	fi
	if [ "$do_newsgroup" ] && [ -n "$(newsgroup "$user")" ]; then
		return (((usenet - "$user" $attr)))
	fi

# ---- end of "from rrouter.cf":

	# Listed in 'expired accounts' database ?
	[ -z "$didexpand" ] && [ -z "$PUNTHOST" ] &&
	    a=$(expired "$user") &&
		db add expansions "$key" expired &&
		return (((error acctexpired "$user" $attr)))

	[ -z "$didexpand" ] &&
	pobox="$(mboxmap "$user")" &&
	tsift "$pobox" in
	([^:]+):([^:]+):(.+)
			if [ "\1" != $hostname ]; then
				db add expansions "$key" mboxmap
				return (((smtp "\1" "$user@\1" $attr)))
			fi
			user="\3"	# this is also good for .forward stuff
			pobox="\2/$POBOX/\3"
			break
			;;
	.+		return (((error database "$user" $attr)))
			;;
	tfist

	priv=$(get $attr privilege)

	# check in the mailing list directory
	lcuser="$(recase -l "$user")"

	l="$preowner$lcuser$postowner$domain"
#	a="$MAILVAR/listrun/$lcuser"
#	[ -f "$a" ] &&
#	    db add expansions "$key" list &&
#	      priv=$(getpriv "644" $priv "$a" maillist) &&
#	        return $(listaddresses	-E "$l" -e "$l"	\
#					-c "$a file expansion" < "$a" |
#		         maprrouter $(newattribute $attr privilege $priv \
#					sender "$l")			 \
#				"$a" "$host" "$plustail" "$domain")

	a="$MAILVAR/lists/$lcuser"
	nattr=()
	#l="$preowner$lcuser$postowner$domain"
	[ -f "$a" ] && [ -z "$didexpand" ] &&
	  db add expansions "$key" list &&
	    priv=$(getpriv "664" $priv "$a" maillist) &&
	      nattr=$(newattribute $attr privilege $priv sender "$l") &&
		return $(listexpand -E "$l" -e "$l" -p $priv		\
				    -c "$a file expansion"		\
				    "$nattr"  "$a" "$host" "" "$domain" < "$a")

	a="$MAILVAR/modlists/$lcuser"
# /bin/ls -lL "$a"
	# WARNING: THIS SHOULD USE  $(listexpand ...) FACILITY !
	if [ -f "$a" ] && [ -z "$didexpand" ] &&
	   db add expansions "$key" list ; then
		priv=$(getpriv "664" $priv "$a" maillist)
		case "$lcuser" in
		*-mod)
			l="$preowner$(basename "$lcuser" -mod)$postowner"
			# echo "$l exists!" >> /dev/tty
			return $(listaddresses	-E "$l$domain"		\
						-e "$l"			\
						-c "$a file expansion" < "$a" |
				maprrouter $(newattribute $attr		\
					      privilege $priv		\
					      sender "$l")		\
					"$a" "$host" "$plustail" "$domain")
			;;
		esac
	fi

	# turn *-owner and *-request into the owner of a mailing list file
	# turn *-group into members listed in /etc/groups

	[ -z "$didexpand" ] &&
	ssift "$lcuser" in
	(.+)-owner
		a="$MAILVAR/lists/\1"
		[ -f "$a" ] &&
		 return $(rrouter "$(uid2login $(filepriv -M 664 "$a"))" \
					 "$host" $attr "$plustail" "$domain")
		break
		;;
	owner-(.+)
		a="$MAILVAR/lists/\1"
		[ -f "$a" ] &&
		 return $(rrouter "$(uid2login $(filepriv -M 664 "$a"))" \
					 "$host" $attr "$plustail" "$domain")
		break
		;;
	(.+)-request
		a="$MAILVAR/lists/\1"
		[ -f "$a" ] &&
		 return $(rrouter "$(uid2login $(filepriv -M 664 "$a"))" \
					 "$host" $attr "$plustail" "$domain")
		break
		;;
	(.*)-group
		a="$(groupmembers "\1")" &&
		  db add expansions "$key" list &&
		  return $(echo $a |
			   listaddresses -e postmaster -c "$lcuser expansion" |
			   maprrouter $(newattribute $attr sender postmaster) \
				"$lcuser" "$host" "$plustail" "$domain")
		;;
	tfiss


if false ; then

# listserv automatic list alias mapping support, the listserv home
# probably should go to zmailer.conf or elsewhere at some time
# but let's keep it simple during testing <hks@nic.funet.fi> 1998
# We check first zmailer lists that can override listserv in an
# emergency, for example.
#
	LISTSERV="/v/net/listserv.funet.fi"
	a="$LISTSERV/home/$lcuser.list"
  
	if [ -f "$a" ] ; then
		return (((local pipe.$lcuser "|$LISTSERV/bin/lsv_amin $LISTSERV/lsvspool $lcuser" $(newattribute $attr privilege "0" ))))
	fi

	ssift "$lcuser" in

	owner-(.+)
		listbase="\1"
		a="$LISTSERV/home/$listbase.list"
		if [ -f "$a" ]; then
		   return (((local pipe.owner-$listbase "|$LISTSERV/bin/lsv_amin $LISTSERV/lsvspool owner-$listbase" $(newattribute $attr privilege "0" ))))
		fi
		;;

	(.+)-owner
		listbase="\1"
		a="$LISTSERV/home/$listbase.list"
		if [ -f "$a" ]; then
		   return (((local pipe.owner-$listbase "|$LISTSERV/bin/lsv_amin $LISTSERV/lsvspool owner-$listbase" $(newattribute $attr privilege "0" ))))
		fi
		;;

	(.+)-search-request
		listbase="\1"
#listsserv search facility support <hks>
		a="$LISTSERV/home/$listbase.list"
		if [ -f "$a" ]; then
		   return (((local pipe.$listbase-search-request "|$LISTSERV/bin/lsv_amin $LISTSERV/lsvspool $listbase-search-request" $(newattribute $attr privilege "0" ))))
		fi
		;;

	(.+)-request
		listbase="\1"
		a="$LISTSERV/home/$listbase.list"
		if [ -f "$a" ] ; then
		   return (((local pipe.$listbase-request "|$LISTSERV/bin/lsv_amin $LISTSERV/lsvspool $listbase-request" $(newattribute $attr privilege "0" ))))
		fi
		;;

	(.+)-server
		listbase="\1"
#listsserv search facility support <hks>
		a="$LISTSERV/home/$listbase.list"
		if [ -f "$a" ]; then
		   return (((local pipe.$listbase-server "|$LISTSERV/bin/lsv_amin $LISTSERV/lsvspool $listbase-server" $(newattribute $attr privilege "0" ))))
		fi
		;;
	(.+)
		listbase="\1"
		a="$LISTSERV/home/$listbase.list"
		if [ -f "$a" ] ; then
		   return (((local pipe.owner-$listbase "|$LISTSERV/bin/lsv_amin $LISTSERV/lsvspool owner-$listbase" $(newattribute $attr privilege "0" ))))
		fi
		break
		;;
	tfiss
fi

#	only allow .forward file reading if privs allow it

	hashomedir=0
	if homedir="$(homedirectory "$user")" ; then
		hashomedir=1
	else
	    ssift "$user" in # No 'homedir' for this user ? Has a '+' in it ?
	    (.+)\+.+
		# Try expanding 'user+', and then plain 'user'
		didexpand=$(expansions "$(channel $quad)\1+")
		if [ -n "$didexpand" ] ; then
			return (((bitbucket "$(host $quad)2" "$(user $quad)" $(attributes $quad))))
			# Return empty -- plusfull was expanded!
		fi
		if a="$(aliases "\1+")"; then
		  db add expansions "$key" alias
		  nattr=$(newattribute $attr privilege $priv)

		  return $(echo "$a" |			\
			 listaddresses	-E "root"	\
					-e "root"	\
					-c "$user alias expansion" | \
			maprrouter $nattr "$user" "$host" \
					 "$plustail" "$domain")

		fi
		# For a "user+" there is no homedirectory, try plusless below
		;;
	    (.+)\+(.*)
		# It was 'user+', try now plain 'user' for
		# aliases, and .forward
		didexpand=$(expansions "$(channel $quad)\1") &&
		if [ -n "$didexpand" ] ; then
			return (((bitbucket "$(host $quad)3" "$(user $quad)" $(attributes $quad))))
			# Return empty -- plusfull was expanded!
		fi

		plustail2="+\2"

		if a="$(aliases "\1")"; then
		  db add expansions "$key" alias
		  nattr=$(newattribute $attr privilege $priv)

		  return $(echo "$a" |			\
			 listaddresses	-E "root"	\
					-e "root"	\
					-c "$user alias expansion" | \
			maprrouter $nattr "$user" "$host" \
					 "$plustail2" "$domain")

		fi

		a="$(fullnamemap "\1")" && \
		  return $(rrouter "$a" "$user" $attr "$plustail2" "$domain")

		pobox="$(mboxmap "\1")" &&
		  tsift "$pobox" in
		  ([^:]+):([^:]+):(.+)
			if [ "\1" != $hostname ]; then
				db add expansions "$key" mboxmap
				return (((smtp "\1" "$user@\1" $attr)))
			fi
			plustail="$plustail2"
			user="\3"	# this is also good for .forward stuff
			pobox="\2/$POBOX/\3"
			break
			;;
		  .+	return (((error database "$user" $attr)))
			;;
		  tfist

		if homedir="$(homedirectory "\1")"; then
			hashomedir=1
		fi
		;;
	    tfiss
	fi

	forward="$homedir/.forward"

	case "$(get $attr type)" in
	expandsender)	[ -f "$forward" ] && return (($quad))
			;;
	esac

	priv=$(get $attr privilege)

	if [ -z "$didexpand" -a -z "$PUNTHOST" ] && [ "$hashomedir" ] &&
	   [ -f "$forward" ] ; then
	  db add expansions "$key" user &&
	    priv=$(getpriv "644" $priv "$forward" .forward) &&
	      return $(listaddresses -e '"\\'"$user"'"' -c "$forward .forward expansion" < "$forward" | \
			 maprrouter $(newattribute $attr privilege $priv) \
				"$forward" "$host" "$plustail" "$domain")
	fi

	# local user with no alias and no .forward file

	[ -z "$didexpand" ] &&
	if [ -n "$pobox" ]; then
		db add expansions "$key" pobox
		priv=$(login2uid "$user")
		return (((local "pob:$user" "$pobox$plustail$domain" $(newattribute $attr privilege $priv))))
	fi


	# oh well... give up, and sent to the PUNTHOST
	if [ -n "$PUNTHOST" ]; then
		return $(rrouter "$user$plustail"@$PUNTHOST "$host" $attr "" "$domain")
	elif [ -n "$didexpand" ]; then
		case "$didexpand" in
		user|alias)
			db add expansions "$key" other
			;;
		local)
			# This is nasty special case -- a failing .forward
			# will generate "\user" which in turn will generate
			# didexpand="local" and $user without the leading \
			# Treat it as local delivery.
			return (((local "$(host $quad)" "$user" $(attributes $quad))))
			;;
		*)	# the address just disappears... we've got it already
			#log expansion "$(expansions "$key"):"
			#return ()
			return (((bitbucket "$(host $quad)5" "$(user $quad)" $(attributes $quad))))
			;;
		esac
	fi

	case "$user" in
	uid#*)	return $(rrouter postmaster "$host" $attr "" "$domain")
		;;
	esac


# Ending case 1: If not POBOX, let local channel handle it
	case "x$POBOX" in
	x)	db add expansions "$key" local
		if [ -z "$localdoesdomain" ]; then
			domain=""
		fi
		quad=($chan "$host" "$user$plustail$domain" $attr)
		return (($quad))
		;;
	esac

# Ending case 2: If not POBOX, nor homedirectory defined, then
#                fall to "error" case below.

	case "${hashomedir}x$POBOX" in
	1x)	db add expansions "$key" local
		if [ -z "$localdoesdomain" ]; then
			domain=""
		fi
		quad=($chan "$host" "$user$plustail$domain" $attr)
		return (($quad))
		;;
	esac

	return (((error err.nosuchuser "$user$plustail$domain" $attr)))
}

# Usage: getpriv <maxperm> <present privilege> <filename> <filename type>
#
# Determine the privileges associated with addresses coming from the filename.
# The type value is one of .forward, maillist, or include.  Setting
# private='' ensures that noone can access (modulo a small window) information
# through the mailer (e.g., by sending mail to addresses taken from a
# protected file and waiting excitedly for the informative bounce messages)
# that they couldn't access otherwise.  If private='.forward maillist' then
# people stop complainig about the former behaviour...

getpriv (maxperm, priv, file, type) {
#echo "getpriv($maxperm, $priv, $file, $type)" > /dev/tty
	for ptype in $private
	do
		if [ $type = $ptype ]; then
			filepriv -M $maxperm "$file"
			return $?
		fi
	done
	runas $priv filepriv -M $maxperm "$file"
}

# Usage: newattribute <oldattribute> <key1> <value1> [ <key2> <value2> ] ...
#
# Returns a new attribute list symbol with the <keyN> <valueN>
# attributes added to the contents of the <oldattribute> list.

newattribute (oldattribute) {
	local a null value
#echo "newattribute(old=$oldattribute,args=$*)" > /dev/tty
	a=$(gensym)
	eval $a=\$$oldattribute
	while [ "$#" != 0 ];
	do
		lreplace $a "$1" "$2"
		# value=$(get $a "$1")
		# if [ x"$value" != x"$2" ]; then
		# 	null=$(setf $(get $a "$1") "$2")
		# fi
		shift ; shift
	done
	echo "$a"
}

# Usage: maprrouter <newattributes> <what-is-being-expanded> <what-it-was>
#
# This function applies the rrouter function to each address read from
# stdin, passing the <newattributes> parameter.  In case of error, the
# localpart parameter is used as appropriate descriptive text.  The
# return value is the concatenation of the return values of the rrouter
# invocations.

maprrouter (attribute, localpart, origaddr, plustail, domain) {
	local shh al

	al=()
	while read address
	do
		case "$address" in
		'')	shh=(((error expansion "$localpart")))
			lappend al $shh
			continue
			;;
		esac

		defer=''
		shh=$(rrouter "$address" "$origaddr" $attribute \
			"$plustail" "$domain")
		[ "$defer" ] &&
		    shh=(((hold "$defer" "$address" $attribute)))
		defer=''
		lappend al $shh
	done
	return $al
}
