#-h- sndsym           151 asc 28-oct-80 23:59:40 tools
 define(USERSIZE,60)
 define(DO_ALL,1)
 define(DO_FIRST,2)
 define(TIMEZONE,"PST")
 define(RIGHTMARGIN,80)
 define(TERMEOF,"^Z")
 define(USERWIDTH,15)
#-h- csndm            412 asc 28-oct-80 23:59:40 tools
 common / csndm / tofile(FILENAMESIZE), ccfile(FILENAMESIZE),
		  subjct(MAXLINE), msgfil(FILENAMESIZE),
		  reply(MAXLINE)

 character tofile	# file containing To addresses; init = EOS
 character ccfile	# file containing Cc addresses; init = EOS
 character subjct	# subject string for message; init = EOS
 character msgfil	# file containing message; init = EOS
 character reply	# in-reply-to string; init = EOS
#-h- sndscr           407 asc 28-oct-80 23:59:41 tools
 common / sndscr / nusers, temp0(FILENAMESIZE), temp1(FILENAMESIZE),
		   temp2(FILENAMESIZE), temp3(FILENAMESIZE)

 integer nusers		# running count of valid users
 character temp0	# temporary file for complete message
 character temp1	# temporary file to hold processed To addresses
 character temp2	# temporary file to hold processed Cc addresses
 character temp3	# temporary file to hold body of message
#-h- sndbuf            95 asc 28-oct-80 23:59:42 tools
 common / scrbuf / buf(MAXLINE)

 character buf		# scratch buffer used for getlin's throughout
#-h- cpb              115 asc 28-oct-80 23:59:42 tools
 common / cpb / bp, bf(MAXLINE)

 integer bp		# put back pointer for gadtok
 character bf		# buffer used by gadtok
#-h- sndmsg.r       12944 asc 28-oct-80 23:59:44 tools
#-h- main             720 asc 20-oct-80 12:32:28
 include sndsym

 subroutine main

 include csndm
 include sndscr

 string tos "To: "
 string ccs "Cc: "
 string errmsg "No valid user names specified."

 call sndcmd				# process command arguments
 call sndint				# initialize lookup table
 nusers = 0				# initialize number of users
 call sndadr(tofile, temp1, tos)	# get To addresses
 call sndadr(ccfile, temp2, ccs)	# get Cc addresses
 if (nusers == 0)
    call snderr(errmsg)			# no valid users
 call getsbj(subjct)			# get subject string
 call genmsg(msgfil, temp3)		# get body of message
 call mmerge				# merge pieces onto temp0
 call sdmail(temp0, temp1)		# send to To
 call sdmail(temp0, temp2)		# send to Cc
 call cleanf				# clean up temp files

 return
 end
#-h- sndcmd           732 asc 21-oct-80 16:45:24
 subroutine sndcmd

 integer i
 integer getarg, equal
 character clower

 include csndm
 include sndbuf

 string quest "?"

 tofile(1) = EOS
 ccfile(1) = EOS
 msgfil(1) = EOS
 reply(1) = EOS
 subjct(1) = EOS
 for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1)
    if (equal(buf, quest) == YES)
	call error("usage:  sndmsg [-tfile] [-cfile] [-ssubject] [-rreply].")
    else if (buf(1) == MINUS)
	switch(clower(buf(2)))
	    {
	    case LETT:	call scopy(buf, 3, tofile, 1)
	    case LETC:	call scopy(buf, 3, ccfile, 1)
	    case LETS:	call scopy(buf, 3, subjct, 1)
	    case LETM:	call scopy(buf, 3, msgfil, 1)
	    case LETR:	call scopy(buf, 3, reply, 1)
	    default:	call badarg(buf)
	    }
    else
	call badarg(buf)

 return
 end
#-h- badarg           153 asc 20-oct-80 12:32:29
 subroutine badarg(arg)

 character arg(ARB)

 string errmsg "Ignoring invalid argument: "

 call putlin(errmsg, ERROUT)
 call remark(arg)

 return
 end
#-h- sndint           629 asc 20-oct-80 12:32:30
 subroutine sndint

 character user(USERSIZE), file(FILENAMESIZE)
 integer int, i, junk
 integer open, getlin, getwrd

 include sndscr
 include sndbuf

 string sm0 "sm0"
 string sm1 "sm1"
 string sm2 "sm2"
 string sm3 "sm3"

 call tbinit
 call adrfil(file)
 int = open(file, READ)
 if (int != ERR)
    {
    while (getlin(buf, int) != EOF)
	{
	i = 1
	junk = getwrd(buf, i, user)
	junk = getwrd(buf, i, file)
	call instal(user, file)
	}
    call close(int)
    }
 else
    call error("Cannot open local user file.")
 call scratf(sm0, temp0)
 call scratf(sm1, temp1)
 call scratf(sm2, temp2)
 call scratf(sm3, temp3)

 return
 end
#-h- cleanf           131 asc 20-oct-80 12:32:30
 subroutine cleanf

 include sndscr

 call remove(temp0)
 call remove(temp1)
 call remove(temp2)
 call remove(temp3)

 return
 end
#-h- snderr            90 asc 20-oct-80 12:32:31
 subroutine snderr(buf)

 character buf(ARB)

 call cleanf
 call error(buf)

 return
 end
#-h- getsbj           277 asc 20-oct-80 12:32:31
 subroutine getsbj(subjct)

 character subjct(MAXLINE)
 integer n
 integer prompt, tty

 string pstr "Subject: "

 if (subjct(1) == EOS & tty(STDIN) == YES)
    {
    n = prompt(pstr, subjct, STDIN)
    if (n > 0)
	subjct(n) = EOS
    else
	subjct(1) = EOS
    }

 return
 end
#-h- sdmail           863 asc 20-oct-80 12:32:32
 subroutine sdmail(msg, mlist)

 integer inp, int, n, junk, out, topfil(2)
 integer open, getlin, lookup, create
 character msg(ARB), mlist(ARB), file(FILENAMESIZE)

 include sndbuf

 string mymail "mymail"
 string posted "Mail posted to "
 string errmsg "Cannot send mail to "

 inp = open(msg, READ)
 if (inp != ERR)
    {
    call markl(inp, topfil)
    int = open(mlist, READ)
    if (int != ERR)
	{
	for (n=getlin(buf,int); n != EOF; n=getlin(buf,int))
	    {
	    buf(n) = EOS
	    junk = lookup(buf, file)
	    call concat(file, mymail, file)
	    call seek(topfil, inp)
	    out = create(file, APPEND)
	    if (out == ERR)
		{
		call putlin(errmsg, ERROUT)
		call remark(buf)
		}
	    else
		{
		call fcopy(inp, out)
		call close(out)
		call putlin(posted, ERROUT)
		call remark(buf)
		}
	    }
	call close(int)
	}
    call close(inp)
    }

 return
 end
#-h- domlst           618 asc 20-oct-80 12:32:33
 subroutine domlst(file, key, unit)

 integer key, unit, int, i
 integer open, getlin, index, getwrd
 character file(ARB), token(USERSIZE)

 include sndbuf

 string errmsg "Error opening mailing list file: "

 int = open(file, READ)
 if (int != ERR)
    {
    while (getlin(buf, int) != EOF)
	{
	i = index(buf, SHARP)
	if (i > 0)
	    buf(i) = EOS
	i = 1
	if (getwrd(buf, i, token) > 0)
	    call addusr(token, unit)
	if (key == DO_ALL)
	    while (getwrd(buf, i, token) > 0)
		call addusr(token, unit)
	}
    call close(int)
    }
 else
    {
    call putlin(errmsg, ERROUT)
    call remark(file)
    }

 return
 end
#-h- addusr           822 asc 20-oct-80 12:32:34
 subroutine addusr(user, unit)

 integer unit, n
 integer lookup, tty, prompt
 character user(USERSIZE), temp(FILENAMESIZE), utemp(USERSIZE)
 character clower

 include sndscr

 string errmsg "Invalid user name: "
 string qpstr "Do you wish to f[orget it], r[eplace it] or l[ist valid users]? "
 string rpstr "Replacement address: "

 call scopy(user, 1, utemp, 1)
 repeat
    {
    if (lookup(utemp, temp) == YES)
	{
	nusers = nusers + 1
	call putlin(utemp, unit)
	call putch(NEWLINE, unit)
	break
	}
    else
	{
	call putlin(errmsg, ERROUT)
	call remark(utemp)
	if (tty(STDIN) == YES)
	    {
	    n = prompt(qpstr, utemp, STDIN)
	    switch (clower(utemp(1)))
		{
		case LETR:	{ n=prompt(rpstr,utemp,STDIN); utemp(n)=EOS }
		case LETL:	{ call usrlst; utemp(1) = EOS }
		default:	return
		}
	    }
	}
    }

 return
 end
#-h- pbinit            56 asc 20-oct-80 12:32:35
 subroutine pbinit

 include cpb

 bp = 0

 return
 end
#-h- sndadr           781 asc 20-oct-80 12:32:35
 subroutine sndadr(infile, outfil, pstr)

 character infile(ARB), outfil(ARB), pstr(ARB), token(USERSIZE)
 integer int, out
 integer open, create, gadtok, equal, tty

 string all "all"

 if (infile(1) == EOS)
    if (tty(STDIN) == YES)
	int = STDIN
    else
	int = ERR
 else
    int = open(infile, READ)
 if (int == ERR)
    return
 out = create(outfil, WRITE)
 if (out != ERR)
    {
    call pbinit
    while (gadtok(pstr, token, int) != EOF)
	if (token(1) == LESS)
	    {
	    call scopy(token, 2, token, 1)
	    call domlst(token, DO_ALL, out)
	    }
	else if (equal(token, all) == YES)
	    {
	    call adrfil(token)
	    call domlst(token, DO_FIRST, out)
	    }
	else
	    call addusr(token, out)
    call close(out)
    }
 if (int != STDIN)
    call close(int)

 return
 end
#-h- mmerge           334 asc 20-oct-80 12:32:36
 subroutine mmerge

 integer out, int
 integer create, open

 include sndscr

 string errmsg "Error opening temp0."

 out = create(temp0, WRITE)
 if (out == ERR)
    call snderr(errmsg)
 call pstmrk(out)
 int = open(temp3, READ)
 if (int != ERR)
    {
    call fcopy(int, out)
    call close(int)
    }
 call close(out)

 return
 end
#-h- pstmrk          1030 asc 21-oct-80 16:45:31
 subroutine pstmrk(int)

 integer int
 character idate(10), itime(10), user(USERSIZE), hdrpat(4)

 include csndm
 include sndscr
 include sndbuf

 string dates "Date:    "
 string dashst " - "
 string timzon TIMEZONE
 string froms "From:    "
 string subjs "Subject: "
 string repls "In-reply-to: "
 string tos   "To:     "
 string ccs   "Cc:     "

 data hdrpat/1, 1, NEWLINE, EOS/

 call mailid(user, buf)
 call gdate(idate)
 call gtime(itime)
 call putlin(hdrpat, int)
 call putlin(dates, int)
 call putlin(idate, int)
 call putch(BLANK, int)
 call putlin(itime, int)
 call putlin(dashst, int)
 call putlin(timzon, int)
 call putch(NEWLINE, int)
 call putlin(froms, int)
 call putlin(user, int)
 call putch(NEWLINE, int)
 call putlin(subjs, int)
 call putlin(subjct, int)
 call putch(NEWLINE, int)
 if (reply(1) != EOS)
    {
    call putlin(repls, int)
    call putlin(reply, int)
    call putch(NEWLINE, int)
    }
 call dotcst(temp1, tos, int, buf)
 call dotcst(temp2, ccs, int, buf)
 call putch(NEWLINE, int)

 return
 end
#-h- gadtok           706 asc 20-oct-80 12:32:38
 integer function gadtok(pstr, token, int)

 integer i, int
 integer prompt, length, equal
 character pstr(ARB), token(USERSIZE)

 include cpb

 string help "?@n"

 repeat
    {
    while (bp == 0)
	{
	if (prompt(pstr, bf, int) == EOF)
	    return(EOF)
	if (equal(bf, help) == YES)
	    {
	    call adhelp
	    bp = 0
	    }
	else
	    bp = 1
	}
    if (bf(bp) == NEWLINE)
	return(EOF)
    call skipbl(bf, bp)
    for (i=1; ; i=i+1)
	{
	if (bf(bp) == COMMA | bf(bp) == NEWLINE)
	    break
	token(i) = bf(bp)
	bp = bp + 1
	}
    token(i) = EOS
    if (bf(bp) == COMMA)
	{
	bp = bp + 1
	if (bf(bp) == NEWLINE)
	    bp = 0
	}
    call sqzblk(token)
    i = length(token)
    if (i > 0)
	return(i)
    }

 end
#-h- genmsg          1449 asc 20-oct-80 12:32:38
 subroutine genmsg(infile, outfil)

 character infile(ARB), outfil(ARB), file(FILENAMESIZE)
 character clower
 integer out, edit, int, junk
 integer create, open, tty, prompt, getlin, fsize

 include sndbuf

 string errmsg "Error generating message to send."
 string pstr "Do you want to use ed to create your mail? [y/n] "
 string sde "sde"
 string inps "Input message: (type q to quit or "
 string eofs TERMEOF

 out = create(outfil, WRITE)
 if (out == ERR)
    call snderr(errmsg)
 edit = NO
 if (infile(1) != EOS)
    int = open(infile, READ)
 else
    int = STDIN
 if (int == STDIN & tty(int) == YES)
    {
    junk = prompt(pstr, buf, STDIN)
    if (clower(buf(1)) == LETY)
	{
	edit = YES
	call scratf(sde, file)
	call remark("You are now entering ed to create your mail.")
	call remark("Please wait for ed to prompt for a command.")
	call editit(file, buf)
	int = open(file, READ)
	}
    else
	{
	call putlin(inps, ERROUT)
	call putlin(eofs, ERROUT)
	call remark(" to send).")
	}
    }
 if (int == ERR)
    {
    call close(out)
    call snderr(errmsg)
    }
 while (getlin(buf,int) != EOF)
    if (clower(buf(1)) == LETQ & buf(2) == NEWLINE & edit == NO & int == STDIN)
	{
	call close(out)
	call remove(outfil)
	out = create(outfil, WRITE)
	break
	}
    else
	call putlin(buf, out)
 call close(out)
 if (fsize(outfil) == 0)
    call snderr(errmsg)
 if (int != STDIN)
    call close(int)
 if (edit == YES)
    call remove(file)

 return
 end
#-h- sqzblk           219 asc 20-oct-80 12:32:39
 subroutine sqzblk(token)

 character token(ARB)
 integer i, j

 j = 1
 for (i=1; token(i) != EOS; i=i+1)
    if (token(i) != BLANK & token(i) != TAB)
	{
	token(j) = token(i)
	j = j + 1
	}
 token(j) = EOS

 return
 end
#-h- editit           438 asc 20-oct-80 12:32:40
 subroutine editit(file, buf)

 character file(FILENAMESIZE), buf(ARB), proc(FILENAMESIZE), pid(PIDSIZE)
 integer i, spawn, loccom

 string ed "ed"

 call impath(buf)
 if (loccom(ed, buf, proc) != BINARY)
    call error("Cannot locate ed image file.")
 i = 1
 call stcopy(ed, 1, buf, i)
 call chcopy(BLANK, buf, i)
 call scopy(file, 1, buf, i)
 if (spawn(proc, buf, pid, WAIT) != OK)
    call error("Error in spawning ed!")

 return
 end
#-h- adhelp           758 asc 20-oct-80 12:32:41
 subroutine adhelp

 call remark("Valid responses to the To and Cc prompts are sequences")
 call remark("of usernames separated by commas.  If it is necessary")
 call remark("to continue the list of users on the next line, simply")
 call remark("type a comma before hitting the carriage return.")
 call putch(NEWLINE, ERROUT)
 call remark("If the username 'all' is specified, all known users on")
 call remark("the system will be included.  A username preceded by a")
 call remark("less than symbol (<) is taken to be the name of a file")
 call remark("containing usernames separated by blanks and tabs (old")
 call remark("mail style mailing lists), and each user found therein")
 call remark("will be included.")
 call putch(NEWLINE, ERROUT)

 return
 end
#-h- dotcst           654 asc 20-oct-80 12:32:42
 subroutine dotcst(file, pstr, out, user)

 integer out, in, i, j, n
 integer open, length, getlin
 character user(MAXLINE), file(ARB), pstr(ARB)

 string bls "        "

 in = open(file, READ)
 if (in == ERR)
    return
 call putlin(pstr, out)
 j = 9
 for (i=getlin(user,in); i != EOF; i=getlin(user,in))
    {
    user(i) = EOS
    n = j + length(user) + 1
    if (n > RIGHTMARGIN)
	{
	call putch(COMMA, out)
	call putch(NEWLINE, out)
	call putlin(bls, out)
	j = 9
	}
    if (j > 9)
	call putch(COMMA, out)
    call putch(BLANK, out)
    call putlin(user, out)
    j = j + length(user) + 2
    }
 call putch(NEWLINE, out)
 call close(in)

 return
 end
#-h- usrlst           449 asc 28-oct-80 23:54:43 tools
 subroutine usrlst

 character buf(MAXLINE), obuf(MAXLINE)
 integer int, i, nxtcol
 integer getlin, open

 call adrfil(buf)
 int = open(buf, READ)
 call inpack(nxtcol, RIGHTMARGIN, obuf, ERROUT)
 while (getlin(buf, int) != EOF)
    {
    for (i=1; buf(i) != BLANK & buf(i) != TAB; i=i+1)
	;
    buf(i) = EOS
    call dopack(buf, nxtcol, RIGHTMARGIN, obuf, ERROUT)
    }
 call flpack(nxtcol, RIGHTMARGIN, obuf, ERROUT)
 call close(int)

 return
 end