#-h- bigbld.sh 92 asc 06-aug-83 11:10:10 system (the system) find <~bin/tools.tkb -x "LIBR=" >tools.tkb $1 -v $2 $3 $4 $5 $6 $7 $8 $9 -lmsg rm tools.tkb #-h- ccrlf 91 asc 05-aug-83 17:14:10 sventek (joseph sventek) common / crlf / crlf(10) character crlf # array to map NEWLINES into including padding #-h- cdelvr 77 asc 05-aug-83 17:14:11 sventek (joseph sventek) common / cdelvr / arrdat(40) character arrdat # buffer to hold arrival date #-h- cfiltr 135 asc 05-aug-83 17:14:13 sventek (joseph sventek) common / cfiltr / filter integer filter # whether to filter header lines on output # init = NO; reset to YES by dotype and onemsg #-h- cfscr 152 asc 05-aug-83 17:14:13 sventek (joseph sventek) common / cfscr / file(FILENAMESIZE), scrbuf(MAXLINE) character file # scratch array for file names character scrbuf # scratch array for reading files #-h- chdrs 554 asc 05-aug-83 17:14:14 sventek (joseph sventek) common / chdrs / hsize(2, MAXHEADERS), haddr(MAXHEADERS), hdate(MAXHEADERS), hfrom(MAXHEADERS), hsubj(MAXHEADERS), htext(MAXHEADERS), hstate(MAXHEADERS) integer hsize # size of message in characters linepointer haddr # address of first header line linepointer hdate # address of Date: line in message linepointer hfrom # address of From: line in message linepointer hsubj # address of Subject: line in message linepointer htext # address of start of message text integer hstate # state vector for message #-h- cloggr 323 asc 05-aug-83 17:14:16 sventek (joseph sventek) common / cloggr / slevel, nerrs integer slevel # severity level of logging # 0 => no logging # 1 => internal errors # 2 => communication errors # 3 => trace messages # 4 => babble integer nerrs # number of errors this file integer logvbl(2) # equivalenced array for setlog equivalence (logvbl(1), slevel) #-h- cmail 392 asc 05-aug-83 17:14:17 sventek (joseph sventek) common / cmail / tofile(FILENAMESIZE), ccfile(FILENAMESIZE), bcfile(FILENAMESIZE), infile(FILENAMESIZE), subjst(MAXLINE) character tofile # To addresses from command line character ccfile # cc addresses - empty file character bcfile # Bcc addresses - >~/author.cpy character infile # input file for sndmsg character subjst # subject string; init = EOS #-h- cmhelp 239 asc 05-aug-83 17:14:18 sventek (joseph sventek) common / cmhelp / hlpint, hlpptr(HLPPTRSIZE), hlpscr(HLPPTRSIZE) integer hlpint # unit for help file; init = ERR linepointer hlpptr # pointers into help file for headers linepointer hlpscr # scratch array of line pointers for dohelp #-h- cmline 101 asc 05-aug-83 17:14:18 sventek (joseph sventek) common / cmline / linara(MAXHEADERS) integer linara # array of messages used by various commands #-h- cmsg 883 asc 05-aug-83 17:14:20 sventek (joseph sventek) common / cmsg / nmsgs, curmsg, unit, defalt, rawin, rawout, pagesz, ifmods, home(FILENAMESIZE), file(FILENAMESIZE), scrat(FILENAMESIZE), hdrpat(4) integer nmsgs # number of messages found in file integer curmsg # current message number - set to 1 on read integer unit # rat4 unit number of input file integer defalt # YES if reading mymail, NO otherwise integer rawin # result of rawmod call for STDIN integer rawout # result of rawmod call for STDOUT integer pagesz # set to screen size; PAGESIZE if rawin==rawout==RAW # used by dohead, dotype, dogoto, goback, donext # set by msgint integer ifmods # set if any mods made to this file; init = NO character home # home directory string character file # name of current file character scrat # scratch file to use on E/O commands character hdrpat # string for pattern starting each message (^A^A^J) #-h- cnet 511 asc 05-aug-83 17:14:21 sventek (joseph sventek) common / cnet / donet, nnet, lstnet, netint, tb, netfil(FILENAMESIZE), netscr(MAXLINE) integer donet # switch whether network transmissions are enabled # init = YES, reset by messages from netdlv integer nnet # number of net addresses this file integer lstnet # number used to generate temp names filedes netint # unit to use for file generation pointer tb # pointer to in-memory table character netfil # name of net temp file character netscr # scratch buffer for multiple host routes #-h- cnot 345 asc 05-aug-83 17:14:22 sventek (joseph sventek) common / cnot / nnot, lstnot, notint, sender(MAX_TOK), notfil(FILENAMESIZE) integer nnot # number of addressees to notify integer lstnot # number used to generate temp names filedes notint # unit to use for file generation character sender # path address of sender of this message character notfil # name of notify temp file #-h- cnotfy 240 asc 05-aug-83 17:14:23 sventek (joseph sventek) common / cnotfy / lstpos, uic(128), ofd, file(FILENAMESIZE) integer lstpos # last used location in uic integer uic # buffer of uic's to send to MSGNOT filedes ofd # file descriptor for output file character file # name of scratch file #-h- cpage 216 asc 05-aug-83 17:14:24 sventek (joseph sventek) common / cpage / pagefd, pagesz, ntops filedes pagefd # file descriptor if paging enabled, ERR if not integer pagesz # page size - DEF_PAGE_LEN/HUGE/-/ integer ntops # number of topics displayed - inited to 0 #-h- crest 109 asc 05-aug-83 17:14:25 sventek (joseph sventek) common / crest / rest(MAXLINE) character rest # buffer for fetching rest of header line for From, Date, Sub #-h- csize 116 asc 05-aug-83 17:14:27 sventek (joseph sventek) common / csize / size(2), incs(2) integer size # double integer for size integer incs # double integer increment #-h- csmtp 932 asc 05-aug-83 17:14:28 sventek (joseph sventek) common / csmtp / start, mbegin, nrcpt, table, file(FILENAMESIZE), fhost(HOST_SIZE), myhost(HOST_SIZE), sender(MAX_TOK) integer start # initialized to YES, set to NO by HELO command # used to force HELO as first command integer mbegin # initialized to NO, set to YES upon receipt # of MAIL | SEND | SOML | SAML # reset to NO by termination of DATA command # forces RCPT commands after one of above and # before DATA integer nrcpt # initialized to 0; number of recipients for # this MAIL command; DATA fails if nrcpt == 0 # reset to zero upon receipt of MAIL | * pointer table # pointer to in-memory table of addresses # re-initialized upon receipt of MAIL | * character file # the name of the scratch file for MAILER character fhost # host name of sending host character myhost # host name of receiving host; initialized in sminit character sender # sender's address from MAIL command #-h- csndm 994 asc 05-aug-83 17:14:29 sventek (joseph sventek) common / csndm / dorcpt, nto, ncc, nbcc, tofile(FILENAMESIZE), ccfile(FILENAMESIZE), bcfile(FILENAMESIZE), subjct(MAXLINE), msgfil(FILENAMESIZE), reply(MAXARG), sender(MAX_TOK), reply2(MAX_TOK), msgids(MSG_SIZE), hostnm(HOST_SIZE) integer dorcpt # YES/NO if return receipt desired; init = NO integer nto # number of to addresses integer ncc # number of cc addresses integer nbcc # number of bcc addresses character tofile # file containing To addresses; init = EOS character ccfile # file containing Cc addresses; init = EOS character bcfile # file containing Bcc 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 character sender # sender of message character reply2 # name of this user character msgids # message-id string from Mailer character hostnm # the name of this host #-h- cstat 279 asc 05-aug-83 17:14:31 sventek (joseph sventek) common / cstat / start(7), numadr(2), numchr(2), numfil integer start # start time for this statistics period integer numadr # number of addresses processed this period integer numchr # number of characters moved this period integer numfil # number of message files this period #-h- ctc 367 asc 05-aug-83 17:14:31 sventek (joseph sventek) common / ctc / ntopic, lstbuf, topnam(MAX_TOPICS), toplst(MAX_TOPICS), topbuf(MAX_BUFFER) integer ntopic # number of topics integer lstbuf # last used element of top buf integer topnam # index into topbuf for topic name integer toplst # index into topbuf for entry list for topic character topbuf # character array for topic names and entry lists #-h- decdef 162 asc 05-aug-83 17:14:32 sventek (joseph sventek) define(initrx,decirx) define(inittx,decitx) define(netfin,decfin) define(netget,decget) define(netput,decput) define(smtptx,dmtptx) define(NETWORK_TYPE,"DECNET") #-h- decnet.r 2090 asc 05-aug-83 17:14:33 sventek (joseph sventek) #-h- defns 96 asc 19-apr-82 13:49:33 j (sventek j) define(INCL_CDEC,common/cdec/desc;integer desc) include mailsym include netsym include smtpsym #-h- decfin 165 asc 13-jun-83 14:33:53 sventek (joseph sventek) subroutine decfin integer junk integer netdsc, netcls INCL_CDEC junk = netdsc(desc, 0, 0) junk = netcls(junk) ifdef(PDP_RSX) call altpri(45) enddef return end #-h- decget 175 asc 01-dec-82 11:34:38 sventek (joseph sventek) integer function decget(buf) character buf(incr(MAX_DATA)) integer n integer netrec INCL_CDEC n = netrec(desc, buf, MAX_DATA) if (n != EOF) buf(n+1) = EOS return(n) end #-h- decirx 539 asc 01-nov-82 09:25:55 sventek (joseph sventek) integer function decirx(host) integer status, type, xtra, junk integer netopn, netgnd, netacc, netcls, assign character buf(CON_BLK_SIZE), host(ARB) INCL_CDEC string netnam "decnet" string errorf SMTP_ERROR_FILE junk = assign(errorf, ERROUT, WRITE) if (netopn(status) == OK) { status = netgnd(buf, type, xtra) if (status != ERR) { if (type != CON_REQ) status = ERR else status = netacc(buf, 0, 0, desc) } if (status == ERR) junk = netcls(junk) } call gthost(netnam, host) return(status) end #-h- decitx 543 asc 13-jun-83 14:33:55 sventek (joseph sventek) integer function decitx(thost, fhost) integer status, xtra, junk integer netopn, netcon, netcls character buf(CON_BLK_SIZE), thost(ARB), fhost(HOST_SIZE), inb(16) INCL_CDEC string netnam "decnet" string null "" call gthost(netnam, fhost) if (netopn(status) == OK) { call upper(thost) call netbcb(buf, thost, 254, 0, 0, null, null, null) status = netcon(buf, 0, 0, inb, 16, xtra, desc) if (status == ERR) junk = netcls(junk) ifdef(PDP_RSX) else call altpri(75) # crank up our priority enddef } return(status) end #-h- decput 144 asc 11-feb-82 16:40:18 j integer function decput(buf) character buf(ARB) integer n integer length, netsnd INCL_CDEC n = length(buf) return(netsnd(desc, buf, n)) end #-h- delivr.bld 206 asc 05-aug-83 17:14:35 sventek (joseph sventek) pip delivr.obj@;*/de/nm echo Ignore the error message from TKB which follows ld -v delivr -lmsg ?temp.tkb rc -cv delivr.r ed - temp.tkb < 0) # user's to notify call notusr(bf) if (nnet > 0) call dlvnet(outfil, bf) junk = remove(outfil) junk = remove(file) ifdef(DO_STATISTICS) for (i = 1; i <= ntotal; i = i + 1) { adddi(dint, numchr) # update number of characters incrdi(numadr) # update number of addresses } enddef } } call close(ERROUT) } until (status == EOF) DRETURN end #-h- addnet 538 asc 27-may-82 10:23:41 j (sventek j) subroutine addnet(buf) integer junk character buf(ARB) ext_func pointer iminit ext_func filedes create ext_func integer imput include cnet DS_DECL(Mem,Mem_size) # dynamic storage area string seed "tnetdlv." if (nnet <= 0) { call mgenr8(lstnet, seed, netfil) netint = create(netfil, WRITE) tb = iminit(Mem_size, Ave_size) } nnet = nnet + 1 call rotate(buf) # get dest host at beginning if (imput(tb, buf) != OK) # table full { call dumptb # dump the table junk = imput(tb, buf) # start anew } return end #-h- addnot 242 asc 27-may-82 07:44:32 j (sventek j) subroutine addnot(buf) filedes create character buf(ARB) include cnot string seed "tnotify." if (nnot <= 0) { call mgenr8(lstnot, seed, notfil) notint = create(notfil, WRITE) } nnot = nnot + 1 call putlnl(buf, notint) return end #-h- badmsg 263 asc 29-jun-83 10:28:12 sventek (joseph sventek) subroutine badmsg(buf, reason, file) character buf(ARB), reason(ARB), file(ARB) filedes in, fopen if (fopen(file, READ, in) == ERR) { call errlog(" Cannot open input file: ", file, L_INT) return } call msgret(buf, reason, in) call close(in) return end #-h- cpymsg 901 asc 29-jun-83 10:28:12 sventek (joseph sventek) ifdef(DO_STATISTICS) integer function cpymsg(in, outfil, buf, dint) elsedef integer function cpymsg(in, outfil, buf) enddef filedes in, out, fcreat integer status, getlin, match1, junk, note ifdef(DO_STATISTICS) integer dint(2), size(2) enddef linepointer top character outfil(ARB), buf(MAXLINE) include cdelvr junk = note(top, in) while (getlin(buf, in) != EOF) if (match1(buf, ARRIVAL_TIME_STR) == YES) { call fetrst(buf, arrdat) # save arrival date break } ifdef(DO_STATISTICS) initdi(dint) initdi(size) enddef if (fcreat(outfil, WRITE, out) != ERR) { ifdef(DO_STATISTICS) repeat { size(2) = getlin(buf, in) if (size(2) == EOF) break call putlin(buf, out) adddi(size, dint) } elsedef call fcopy(in, out) enddef call close(out) status = OK } else status = ERR call seek(top, in) return(status) end #-h- dlvnet 1983 asc 29-jun-83 10:28:14 sventek (joseph sventek) subroutine dlvnet(file, bf) character file(FILENAMESIZE), bf(MAXLINE), host(HOST_SIZE) filedes fd, ifd integer i, junk, n, j linepointer addr ext_func filedes open, fopen, fcreat ext_func integer getlin, note, match1, remove include cnet include cnot include cdelvr string temp "~tmp/delivr.tmp" string tost RCPT_TO_STR string arrstr ARRIVAL_TIME_STR call dumptb # flush the table call close(netint) # close the file call lhfile(bf, host) # load hosts file netint = open(netfil, READ) repeat { n = getlin(bf, netint) if (n == EOF) break bf(n) = EOS # overwrite '@n' if (fcreat(temp, WRITE, fd) == ERR) # cannot create temporary with addresses { call errlog(" Cannot create temp file: ", temp, L_INT) # cannot create file break } for (i=1; bf(i) != ','; i=i+1) # save host name host(i) = bf(i) call chcopy(',', host, i) # have string for `match1' calls call angbrk(MAIL_FROM_STR, sender, fd) # output MAIL FROM:<...> call unrot8(bf) # re-order address call angbrk(tost, bf, fd) # output RCPT TO:<...> repeat { junk = note(addr, netint) # note current address n = getlin(bf, netint) # fetch next address if (n == EOF) # all done break bf(n) = EOS # overwrite '@n' if (match1(bf, host) == YES) # same batch { call unrot8(bf) # re-order call angbrk(tost, bf, fd) # output RCPT TO:<...> } else { call seek(addr, netint) # re-position input file break } } call logmsg(arrstr, arrdat, fd) # output ARRIVAL_TIME: separator if (fopen(file, READ, ifd) == ERR) call errlog(" Cannot read input file: ", file, L_INT) else { call fcopy(ifd, fd) call close(ifd) } call close(fd) for (i=2, j=1; host(i) != ','; i=i+1, j=j+1) host(j) = host(i) host(j) = EOS call fold(host) call netdlv(host, bf, temp) } until (n == EOF) call close(netint) junk = remove(temp) junk = remove(netfil) return end #-h- dospwn 563 asc 29-jun-83 10:28:16 sventek (joseph sventek) integer function dospwn(buf, file) character buf(ARB), file(ARB) filedes in, fopen, popen, out, pclose integer stat call prepar(buf) stat = ERR # assume error if (fopen(file, READ, in) == ERR) call errlog(" Cannot open file for reading: ", file, L_INT) else if (popen(buf, WRITE, out) == ERR) { call close(in) call errlog(" Cannot open pipe for writing: ", buf, L_INT) } else { call fcopy(in, out) call close(in) if (pclose(out) != OK) call errlog(" Error piping to sub-process: ", buf, L_INT) else stat = OK } return(stat) end #-h- dotc 245 asc 29-jun-83 10:28:17 sventek (joseph sventek) subroutine dotc(buf, file) character buf(ARB), file(ARB), temp(FILENAMESIZE) integer i integer index call strcpy(buf, temp) call strcpy(SPWN_TC_COMMAND, buf) i = index(buf, '&') call chrstr(buf, i, temp) call mailit(buf, file, "") return end #-h- dumptb 371 asc 27-may-82 10:23:47 j (sventek j) # sorts in-memory array, writes it to file and re-initializes the arrar subroutine dumptb character temp(MAX_TOK) ext_func integer imget ext_func pointer iminit include cnet call imsort(tb) # sort the addresses while (imget(tb, temp) != EOF) # write each one to file call putlnl(temp, netint) tb = iminit(Mem_size, Ave_size) # re-initialize the array return end #-h- lhfile 1056 asc 29-jun-83 10:28:18 sventek (joseph sventek) subroutine lhfile(bf, host) character bf(MAXLINE), host(HOST_SIZE) filedes fd filedes fopen integer j, i, junk integer getlin, getwrd include cnet DS_DECL(Mem,Mem_size) # lookup table dynamic storage string hfile "~msg/hosts" call tbinit(Mem_size) # initialize lookup table if (fopen(hfile, READ, fd) != ERR) # host file is opened { while (getlin(bf, fd) != EOF) { j = 1 repeat { i = 1 junk = getwrd(bf, i, host) call fold(host) for (call skipbl(bf, i); bf(i) != ' ' & bf(i) != '@t'; i = i + 1) call chcopy(bf(i), netscr, j) call chcopy(' ', netscr, j) for (call skipbl(bf, i); bf(i) != '@n'; i = i + 1) call chcopy(bf(i), netscr, j) if (bf(i-1) != '@@') # newline is not escaped break if (getlin(bf, fd) == EOF) { call errlog("Error in last line of file: ", hfile, L_INT) break } netscr(j-1) = '@n' # new line is separator } call tbinst(host, netscr) # install list } call close(fd) } return end #-h- mailit 1316 asc 25-jul-83 16:44:32 sventek (joseph sventek) subroutine mailit(buf, file, whoto) integer i, junk, found, dolock, lockid integer getlin, rindex, pclose, index, length, crlock filedes out, cre8mf, in, fopen, popen character buf(ARB), file(ARB), whoto(ARB), c include cnot string tos "To " c = buf(1) call prepar(buf) if (whoto(1) != EOS) { dolock = YES call errlog(tos, whoto, L_TRACE) } else { dolock = NO call errlog(tos, buf, L_TRACE) } if (c == '|') out = popen(buf, WRITE, out) else { if (dolock == YES) { call fold(whoto) while (crlock(whoto, lockid) == ERR) # keep trying until successful { call errlog("Unable to obtain lock for ", whoto, L_INT) call sleep(5) } } out = cre8mf(buf, APPEND) } if (out != ERR) { if (fopen(file, READ, in) != ERR) { call errlog("From ", sender, L_TRACE) call putlnl(MSG_HEADER, out) call putlnl("X-ST-Status: N", out) call angbrk("Return-path: ", sender, out) while (getlin(buf, in) != EOF) { call scrypt(buf) # decrypt buffer call putlin(buf, out) } call close(in) if (whoto(1) != EOS) call addnot(whoto) } if (c == '|') junk = pclose(out) else call close(out) } else call badmsg(buf, "Cannot access file", file) if (dolock == YES) call rmlock(lockid) return end #-h- netdlv 5871 asc 05-aug-83 15:03:14 sventek (joseph sventek) # # perform network delivery # # this routine actually initiates the network delivery of a message, dependent # upon the host information stored in the table by dlvnet. The code in this # routine is dependent upon the appropriate definition of the symbols in # mailsym of the form: # # define(p_c,routine_name) # # where 'c' is a character in the range a <= c <= z and `routine_name' # is the name of the tranmission routine for that protocol. # # Typically, `routine_name' is the string 'c'mtptx. For example # if the following line appears in the file ~msg/hosts # # snarf * decnet # # then, the following define must appear in mailsym # # define(p_d,dmtptx) # subroutine netdlv(host, buf, outfil) character buf(ARB), outfil(ARB), host(HOST_SIZE), type, lastc character clower integer stat, found, j, i, junk, last, nref integer tblook, getwrd, dospwn, amove, assign, getlin, remove filedes fd filedes fopen # # network specific tx functions - depends upon mailsym # ifdef(p_a) integer p_a enddef ifdef(p_b) integer p_b enddef ifdef(p_c) integer p_c enddef ifdef(p_d) integer p_d enddef ifdef(p_e) integer p_e enddef ifdef(p_f) integer p_f enddef ifdef(p_g) integer p_g enddef ifdef(p_h) integer p_h enddef ifdef(p_i) integer p_i enddef ifdef(p_j) integer p_j enddef ifdef(p_k) integer p_k enddef ifdef(p_l) integer p_l enddef ifdef(p_m) integer p_m enddef ifdef(p_n) integer p_n enddef ifdef(p_o) integer p_o enddef ifdef(p_p) integer p_p enddef ifdef(p_q) integer p_q enddef ifdef(p_r) integer p_r enddef ifdef(p_s) integer p_s enddef ifdef(p_t) integer p_t enddef ifdef(p_u) integer p_u enddef ifdef(p_v) integer p_v enddef ifdef(p_w) integer p_w enddef ifdef(p_x) integer p_x enddef ifdef(p_y) integer p_y enddef ifdef(p_z) integer p_z enddef # # end of network specific functions # include cnet string rseed "xretry." string efile "~tmp/delivr.ptm" data last /0/ stat = ERR found = tblook(host, netscr) if (found == NO) found = tblook("default", netscr) if (found == YES) { call errlog("Processing message for host: ", host, L_TRACE) if (donet == YES) { j = 0 repeat { for (i=1, j=j+1; netscr(j) != EOS; j = j + 1) { call chcopy(netscr(j), buf, i) if (netscr(j) == '@n') break } lastc = netscr(j) i = 1 if (buf(i) == '*') # ditto first field i = i + 1 else junk = getwrd(buf, i, host) call skipbl(buf, i) type = clower(buf(i)) call errlog(" Forwarding message to host: ", host, L_TRACE) call errlog(" Protocol used: ", buf(i), L_TRACE) switch (type) { ifdef(p_a) case 'a': stat = p_a(host, buf, outfil, nref, efile) enddef ifdef(p_b) case 'b': stat = p_b(host, buf, outfil, nref, efile) enddef ifdef(p_c) case 'c': stat = p_c(host, buf, outfil, nref, efile) enddef ifdef(p_d) case 'd': stat = p_d(host, buf, outfil, nref, efile) enddef ifdef(p_e) case 'e': stat = p_e(host, buf, outfil, nref, efile) enddef ifdef(p_f) case 'f': stat = p_f(host, buf, outfil, nref, efile) enddef ifdef(p_g) case 'g': stat = p_g(host, buf, outfil, nref, efile) enddef ifdef(p_h) case 'h': stat = p_h(host, buf, outfil, nref, efile) enddef ifdef(p_i) case 'i': stat = p_i(host, buf, outfil, nref, efile) enddef ifdef(p_j) case 'j': stat = p_j(host, buf, outfil, nref, efile) enddef ifdef(p_k) case 'k': stat = p_k(host, buf, outfil, nref, efile) enddef ifdef(p_l) case 'l': stat = p_l(host, buf, outfil, nref, efile) enddef ifdef(p_m) case 'm': stat = p_m(host, buf, outfil, nref, efile) enddef ifdef(p_n) case 'n': stat = p_n(host, buf, outfil, nref, efile) enddef ifdef(p_o) case 'o': stat = p_o(host, buf, outfil, nref, efile) enddef ifdef(p_p) case 'p': stat = p_p(host, buf, outfil, nref, efile) enddef ifdef(p_q) case 'q': stat = p_q(host, buf, outfil, nref, efile) enddef ifdef(p_r) case 'r': stat = p_r(host, buf, outfil, nref, efile) enddef ifdef(p_s) case 's': stat = p_s(host, buf, outfil, nref, efile) enddef ifdef(p_t) case 't': stat = p_t(host, buf, outfil, nref, efile) enddef ifdef(p_u) case 'u': stat = p_u(host, buf, outfil, nref, efile) enddef ifdef(p_v) case 'v': stat = p_v(host, buf, outfil, nref, efile) enddef ifdef(p_w) case 'w': stat = p_w(host, buf, outfil, nref, efile) enddef ifdef(p_x) case 'x': stat = p_x(host, buf, outfil, nref, efile) enddef ifdef(p_y) case 'y': stat = p_y(host, buf, outfil, nref, efile) enddef ifdef(p_z) case 'z': stat = p_z(host, buf, outfil, nref, efile) enddef case '|': { call scopy(buf, i, buf, 1) nref = 0 junk = assign(efile, STDOUT, WRITE) # child inherits this stat = dospwn(buf, outfil) call close(STDOUT) if (stat == OK) # check for refusals { if (fopen(efile, READ, fd) != ERR) { if (getlin(buf, fd) != EOF) nref = 1 call close(fd) if (nref == 0) junk = remove(efile) } } } default: found = NO } } until (found == NO | lastc != '@n' | stat != ERR) } else stat = ERR } if (found == NO | stat == ERR) { if (found == NO) rseed(1) = 'f' # fatal "retry" else rseed(1) = 's' # try this host again call mgenr8(last, rseed, host) if (amove(outfil, host) == ERR) call errlog("Cannot queue file for redelivery: ", host, L_INT) } else if (nref > 0) # OK, but some addresses refused call queret(efile) # queue for return return end #-h- notusr 543 asc 29-jun-83 10:28:24 sventek (joseph sventek) subroutine notusr(buf) filedes popen, out, in, fopen integer junk, i integer pclose, remove, index character buf(ARB), c include cnot call close(notint) i = 1 call stcopy("notify ", 1, buf, i) if (index(sender, '"') > 0) # use '@'' as separator c = '@'' else c = '"' call chcopy(c, buf, i) call stcopy(sender, 1, buf, i) call chcopy(c, buf, i) if (popen(buf, WRITE, out) != ERR) { if (fopen(notfil, READ, in) != ERR) { call fcopy(in, out) call close(in) } junk = pclose(out) } junk = remove(notfil) return end #-h- prepar 344 asc 14-jan-83 13:23:49 sventek (joseph sventek) # collapse out first character of buf, accounting for quotes subroutine prepar(buf) character buf(ARB), c integer i, j j = 2 call skipbl(buf, j) if (buf(j) == '@'' | buf(j) == '"') { c = buf(j) j = j + 1 } else c = ' ' for (i=1; buf(j) != EOS & buf(j) != '@n' & buf(j) != c; i=i+1, j=j+1) buf(i) = buf(j) buf(i) = EOS return end #-h- prsfil 1356 asc 29-jun-83 10:28:25 sventek (joseph sventek) # parses input file and takes appropriate action ifdef(DO_STATISTICS) subroutine prsfil(in, bf, outfil, ntotal) elsedef subroutine prsfil(in, bf, outfil) enddef character bf(MAXLINE), outfil(FILENAMESIZE), whoto(MAX_TOK) filedes in integer n ifdef(DO_STATISTICS) integer ntotal enddef integer getlin, match1, index, length include cnot string tost RCPT_TO_STR ifdef(DO_STATISTICS) ntotal = 0 enddef while (getlin(bf, in) != EOF) if (match1(bf, MAIL_FROM_STR) == YES) call xtrpth(bf, sender) else if (match1(bf, tost) == YES) { ifdef(DO_STATISTICS) ntotal = ntotal + 1 enddef whoto(1) = EOS n = index(bf, GS) if (n > 0) { bf(n) = EOS call scopy(bf, n+1, whoto, 1) n = length(whoto) # locate '@n' whoto(n) = EOS } call xtrpth(bf, bf) call errlog(tost, bf, L_BABBLE) call errlog("whoto: ", whoto, L_BABBLE) if (index(bf, '@@') > 0) # have network address call addnet(bf) else if (bf(1) == '>' | bf(1) == '|') # perform local delivery call mailit(bf, outfil, whoto) else if (match1(bf, "tc") == YES) # teleconference delivery call dotc(bf, outfil) else call badmsg(bf, "Unrecognized address", outfil) # invalid address } else if (match1(bf, ARRIVAL_TIME_STR) == YES) # end of addresses break return end #-h- msgret 436 asc 29-jun-83 10:28:26 sventek (joseph sventek) subroutine msgret(buf, reason, in) character buf(ARB), reason(ARB) filedes out, fcreat, in integer junk integer remove include cnot string tfile "~msg/delivr.tmp" if (fcreat(tfile, WRITE, out) == ERR) { call errlog(" Cannot create return file: ", tfile, L_INT) return } call putlnl(reason, out) call putlnl(buf, out) call angbrk(MAIL_FROM_STR, sender, out) call fcopy(in, out) call close(out) call queret(tfile) return end #-h- queret 307 asc 29-jun-83 10:28:27 sventek (joseph sventek) # subroutine to queue return messages for mflush to process subroutine queret(file) character file(FILENAMESIZE), rfile(FILENAMESIZE) integer last integer amove call mgenr8(last, "dreturn.", rfile) if (amove(file, rfile) == ERR) call errlog("Error queueing file for return: ", file, L_INT) return end #-h- dostats.sh 40 asc 05-aug-83 17:14:49 sventek (joseph sventek) ed - $1 < 0) doall = YES if (index(arg, 'v') > 0) verbos = YES } else call strcpy(arg, topic) } call dohtc(ncol, verbos, doall, topic) DRETURN end #-h- dohtc 2006 asc 16-jun-83 13:15:14 sventek (joseph sventek) subroutine dohtc(ncol, verbos, doall, topnam) integer ncol, verbos, doall character topnam(FILENAMESIZE) integer desc, i, nxtcol, rm, junk, ntopic integer opendr, gdrprm, indexs, imput, equal, isatty, imget, index, getlin, getwrd character topic(FILENAMESIZE), buf(MAXLINE), cc character gtconf pointer tb pointer iminit filedes pagefd, fd filedes open, fopen DS_DECL(Mem,Mem_size) string tcdir TC_DIRECTORY string topfil "~msg/topics" string nfosuf NFO_SUFFIX string termin TERMINAL_IN string pstr "@nContinue with next topic `&'? [n => NO] " tb = iminit(Mem_size, Ave_tok_size) if (fopen(topfil, READ, fd) != ERR) { while (getlin(buf, fd) != EOF) { i = 1 junk = getwrd(buf, i, topic) call fold(topic) if (doall == YES) junk = imput(tb, topic) else if (equal(topic, topnam) == YES) { junk = imput(tb, topic) break } } call close(fd) } else if (opendr(tcdir, desc) != ERR) { while (gdrprm(desc, topic) != EOF) { call fold(topic) i = indexs(topic, nfosuf) if (i > 0) { topic(i) = EOS if (doall == YES) junk = imput(tb, topic) else if (equal(topic, topnam) == YES) { junk = imput(tb, topic) break } } } call closdr(desc) } else call error("? Error opening directory of tc topics") call imsort(tb) pagefd = ERR if (verbos == NO) { rm = 16 * ncol call inpack(nxtcol, rm, buf, STDOUT) } else if (isatty(STDOUT) == YES) pagefd = open(termin, READWRITE) while (imget(tb, topic) != EOF) { ntopic = ntopic + 1 if (verbos == NO) call dopack(topic, nxtcol, rm, buf, STDOUT) else { if (ntopic > 1) { call strcpy(pstr, buf) i = index(buf, '&') call chrstr(buf, i, topic) cc = gtconf(buf, pagefd) if (cc == 'n') next else if (cc == EOF) break } call dsphlp(topic, buf) } } if (verbos == NO) call flpack(nxtcol, rm, buf, STDOUT) return end #-h- dsphlp 781 asc 06-jul-83 15:46:41 sventek (joseph sventek) subroutine dsphlp(topic, buf) character topic(FILENAMESIZE), buf(MAXLINE) character file(FILENAMESIZE) filedes fd filedes fopen integer getlin, equal string nfosuf NFO_SUFFIX string helpst ":help@n" string hlpstr "@n@nHelp information for topic: " string errstr "? Cannot provide help information on topic: " call gtcfil(topic, nfosuf, file) if (fopen(file, READ, fd) == ERR) { call putlin(errstr, ERROUT) call putlnl(topic, ERROUT) return } while (getlin(buf, fd) != EOF) if (equal(buf, helpst) == YES) { call putlin(hlpstr, STDOUT) call putlnl(topic, STDOUT) call putch('@n', STDOUT) while (getlin(buf, fd) != EOF) { if (buf(1) == ':') break call putlin(buf, STDOUT) } break } call close(fd) return end #-h- mail.r 3376 asc 05-aug-83 17:14:54 sventek (joseph sventek) #-h- defns 17 asc 30-mar-82 13:51:01 v1.1 (sw-tools v1.1) include mailsym #-h- main 450 asc 16-jun-83 13:33:15 sventek (joseph sventek) DRIVER(mail) integer isatty, spwsnd integer status filedes out filedes fcreat include cmail string min "min" call malint # fill in to, cc, and bcc files if (isatty(STDIN) == NO) { call scratf(min, infile) if (fcreat(infile, WRITE, out) == ERR) call merror("Cannot create input file for sndmsg") call fcopy(STDIN, out) call close(out) } if (spwsnd(status) == ERR) call merror("Error spawning sndmsg") call mclean DRETURN end #-h- malint 1212 asc 16-jun-83 13:33:16 sventek (joseph sventek) subroutine malint integer naddr, i, dobcc integer getarg filedes out filedes fcreat character addr(MAX_TOK) character clower include cmail string usestr "usage: mail [-b] [-ssubject] address [address] ..." string mto "mto" string mcc "mcc" string mbc "mbc" string comnl ",@n" string myself "myself" call query(usestr) dobcc = YES call scratf(mto, tofile) call scratf(mcc, ccfile) call scratf(mbc, bcfile) subjst(1) = EOS if (fcreat(tofile, WRITE, out) == ERR) call merror("Cannot create file of addresses") naddr = 0 for (i = 1; getarg(i, addr, MAX_TOK) != EOF; i = i + 1) if (addr(1) == '-') { if (clower(addr(2)) == 's') call strcpy(addr, subjst) else if (clower(addr(2)) == 'b') dobcc = NO else call badarg(addr) } else { call putlin(addr, out) call putlin(comnl, out) naddr = naddr + 1 } call close(out) if (naddr == 0) call merror(usestr) if (fcreat(ccfile, WRITE, out) == ERR) call merror("Cannot create cc file") call putch('@n', out) call close(out) if (fcreat(bcfile, WRITE, out) == ERR) call merror("Cannot create bcc file") if (dobcc == YES) call putlnl(myself, out) else call putch('@n', out) call close(out) return end #-h- mclean 163 asc 30-mar-82 13:51:05 v1.1 (sw-tools v1.1) subroutine mclean integer junk integer remove include cmail junk = remove(tofile) junk = remove(ccfile) junk = remove(bcfile) junk = remove(infile) return end #-h- merror 64 asc 30-mar-82 13:51:06 v1.1 (sw-tools v1.1) subroutine merror(msg) call mclean call error(msg) return end #-h- spwsnd 1020 asc 16-jun-83 14:10:58 sventek (joseph sventek) subroutine spwsnd(status) integer status, i integer loccom, spawn, index character args(ARGBUFSIZE), image(FILENAMESIZE), pid(PIDSIZE), c include cmail string suffix IMAGE_SUFFIX string spath STD_PATH string sndmsg "sndmsg" string minust " -t" string minusc " -c" string minusb " -b" string blklss " <" if (loccom(sndmsg, spath, suffix, image) != BINARY) call merror("Error locating sndmsg image file") i = 1 call stcopy(sndmsg, 1, args, i) call stcopy(minust, 1, args, i) call stcopy(tofile, 1, args, i) call stcopy(minusc, 1, args, i) call stcopy(ccfile, 1, args, i) call stcopy(minusb, 1, args, i) call stcopy(bcfile, 1, args, i) if (infile(1) != EOS) { call stcopy(blklss, 1, args, i) call stcopy(infile, 1, args, i) } if (subjst(1) != EOS) { if (index(subjst, '"') > 0) # must use '@'' for arg c = '@'' else c = '"' call chcopy(' ', args, i) call chcopy(c, args, i) call stcopy(subjst, 1, args, i) call chcopy(c, args, i) } status = spawn(image, args, pid, WAIT) return end #-h- mailer.r 7627 asc 05-aug-83 17:14:57 sventek (joseph sventek) #-h- defns 85 asc 12-jul-82 09:14:10 j (sventek j) include mailsym define(Mem_size,arith(arith(4,*,MEM_SIZE),/,3)) # scale memory size #-h- main 4135 asc 08-feb-83 09:31:46 sventek (joseph sventek) DRIVER(mailer) integer last, junk, rlast, i, level, j, msgidc integer assign, rcvmsg, sndmsg, movit, ptreq, amove, remove, note integer index, match1, ctoi character buf(MSG_SIZE), file(FILENAMESIZE), ofile(FILENAMESIZE), bf(MAXLINE), token(MAX_TOK), defn(DEF_SIZE), rstat(MSG_SIZE), whofrm(FILENAMESIZE), efile(FILENAMESIZE), c filedes in, fopen, out, fcreat, eout linepointer top, nextln ifdef(DO_STATISTICS) include cstat string stfile "~msg/stats.mlr" enddef string logfil "~msg/mailer.log" string seed "tdelivr." string rseed "mreturn." string msg1 "Starting file: " string msg2 " Cannot open input file: " string msg3 " Cannot create temp file: " string msg4 " Cannot send message to DELIVR: " string msg6 " Cannot create error file: " string delivr "delivr" string pname "mailer" string reason "Invalid address[es]" string temp "~msg/mailer.tmp" string reload RELOAD_MESSAGE string termn8 TERMINATE_MESSAGE string trace TRACE_MESSAGE string msgidm MSGID_MESSAGE string endmsg "Mailer terminated at the request of " string relmsg "Reloading address and malias files at the request of " string trcmsg "Tracing level set to # by " data last/0/, rlast/0/, msgidc/1/ call minit(pname) # special mail initialization call initad(bf, token, defn) # load symbol tables call setlog(LEVEL_NDX,L_DEFAULT) # enable default logging level ifdef(DO_STATISTICS) call getnow(start) initdi(numadr) initdi(numchr) numfil = 0 enddef repeat { junk = rcvmsg(whofrm, buf) rstat(2) = EOS call setlog(COUNT_NDX,0) # initialize number of errors this file junk = assign(logfil, ERROUT, APPEND) ifdef(DO_STATISTICS) call stdump(OK, stfile) enddef if (match1(buf, reload) == YES) { call initad(bf, token, defn) i = index(buf, GS) + 1 call errlog(relmsg, buf(i), L_TRACE) rstat(1) = OK } else if (match1(buf, termn8) == YES) # received termination message { i = index(buf, GS) + 1 call errlog(endmsg, buf(i), L_TRACE) ifdef(DO_STATISTICS) call stdump(EOF, stfile) enddef rstat(1) = EOF junk = sndmsg(delivr, buf) # pass termination message to delivr } else if (match1(buf, trace) == YES) # change tracing level { i = 1 call skipto(buf, i, DIGIT) # skip to value c = buf(i) level = ctoi(buf, i) if (buf(i) == GS) i = i + 1 j = index(trcmsg, '#') trcmsg(j) = c call errlog(trcmsg, buf(i), L_TRACE) trcmsg(j) = '#' call setlog(LEVEL_NDX, level) # reset logging level rstat(1) = OK junk = sndmsg(delivr, buf) # pass tracing info to delivr } else if (match1(buf, msgidm) == YES) call genid(msgidc, rstat) else { ifdef(DO_STATISTICS) numfil = numfil + 1 enddef call strcpy(buf, file) call errlog(msg1, file, L_TRACE) rstat(1) = ERR # assume error if (fopen(file, READ, in) == ERR) call errlog(msg2, file, L_COMM) else { call mgenr8(last, seed, ofile) if (fcreat(ofile, WRITE, out) == ERR) { call close(in) call errlog(msg3, ofile, L_INT) } else { if (fcreat(temp, WRITE, eout) == ERR) { call close(in) call close(out) junk = remove(ofile) call errlog(msg6, temp, L_INT) } else { call putlnl(reason, eout) junk = note(top, eout) if (movit(in, out, eout, bf, token, defn) != 0) # valid addresses if (sndmsg(delivr, ofile) == ERR) # cannot contact delivr call errlog(msg4, ofile, L_COMM) else rstat(1) = OK else { junk = remove(ofile) # no valid addresses rstat(1) = OK } junk = note(nextln, eout) call close(eout) if (ptreq(top, nextln) == YES) junk = remove(temp) else { call mgenr8(rlast, rseed, efile) junk = amove(temp, efile) } } } } } junk = sndmsg(whofrm, rstat) call close(ERROUT) } until (rstat(1) == EOF) DRETURN end #-h- initad 457 asc 27-may-82 09:05:46 j (sventek j) subroutine initad(buffer, tbuf, defn) character buffer(MAXLINE), tbuf(ARB), defn(ARB), file(FILENAMESIZE) DS_DECL(Mem,Mem_size) PB_DECL(PB_SIZE) string addr "address" string malias "malias" string maldir "~msg/" string null "" call initbl(Mem_size) call concat(maldir, addr, file) call laddrs(file, buffer, tbuf, defn, null) call concat(maldir, malias, file) call lalias(file, buffer, tbuf, defn, null) call lhosts(null, buffer, tbuf, defn) return end #-h- movit 2090 asc 14-jan-83 13:26:46 sventek (joseph sventek) integer function movit(in, out, eout, bf, token, defn) filedes in, out, eout character bf(MAXLINE), token(MAX_TOK), defn(DEF_SIZE), savfrm(MAX_TOK) integer stat, good, bad, i, j integer getlin, match1, gtmtok, index ifdef(DO_STATISTICS) integer dint(2) include cstat enddef string fromst MAIL_FROM_STR string tost RCPT_TO_STR string datast DATA_STR string arrstr ARRIVAL_TIME_STR string trm ">|" good = 0 bad = 0 while (getlin(bf, in) != EOF) if (match1(bf, fromst) == YES) # have FROM: <...> { call strcpy(bf, savfrm) # save for error file call putlin(bf, out) # copy to output file } else if (match1(bf, tost) == YES) # have TO: <...> { ifdef(DO_STATISTICS) incrdi(numadr) enddef if (index(bf, '@@') > 0) { for (i = index(bf, '<'), j = 1; bf(i) != '@n'; i = i + 1, j = j + 1) token(j) = bf(i) token(j) = EOS } else call xtrpth(bf, token) call pbmtok(token, PB_SIZE) for (stat=gtmtok(token,defn,trm); stat != EOF; stat=gtmtok(token,defn,trm)) if (stat == ERR) { bad = bad + 1 call putlnl(token, eout) } else { good = good + 1 call putlin(tost, out) call putch('<', out) call putlin(defn, out) call putch('>', out) if (defn(1) == '>' & token(1) != '>') { call putch(GS, out) call putlin(token, out) } call putch('@n', out) } } else if (match1(bf, datast) == YES) { if (bad > 0) call putlin(savfrm, eout) call putlin(arrstr, out) # separate message with arrival time call ptdate(out) # ... ifdef(DO_STATISTICS) dint(1) = 0 repeat { dint(2) = getlin(bf, in) if (dint(2) == EOF) break adddi(dint, numchr) elsedef while (getlin(bf, in) != EOF) { enddef call scrypt(bf) # encrypt buffer call putlin(bf, out) if (bad > 0) call putlin(bf, eout) } break } call close(in) call close(out) return(good) end #-h- genid 497 asc 07-feb-83 15:44:48 sventek (joseph sventek) # genid - routine to generate a message id # formats up string of the form yymmddhhmmss.`count' # this is returned to the message composer, which will append `@host' subroutine genid(count, buf) integer count, now(7), i, j integer gitocf character buf(ARB) call getnow(now) for (i = 1, j = 1; i <= 6; i = i + 1) j = j + gitocf(now(i), buf(j), 3, 10, 2, '0') buf(j) = '.' j = j + 1 j = gitocf(count, buf(j), 4, 30, 3, '0') count = count + 1 if (count >= arith(30,**,3)) count = 1 return end #-h- mailgen.src 1262 asc 06-aug-83 11:28:34 system (the system) von ratp1 decdef smtptx.r | ratp2 >dmtptx.f rc -cv decnet.r dmtptx.f net.r subs.r sysdep.r lbr msg.olb/cr=decnet,dmtptx,net,subs,sysdep rm dmtptx.f decnet.obj dmtptx.obj net.obj subs.obj sysdep.obj # VMS rc -cv vmtptx.r # VMS lbr msg.olb/rp=vmtptx # VMS rm vmtptx.obj netasm sysdepasm subasm @ttynotasm @ttynotbld pip *.obj@;*/de delivr.bld; rm delivr.obj rc -v htc.r -lmsg; rm htc.obj rc -v mail.r -lmsg; rm mail.obj rc -v mailer.r -lmsg; rm mailer.obj rc -v mflush.r -lmsg; rm mflush.obj rc -v mretry.r -lmsg; rm mretry.obj bigbld rc msg.r; rm msg.obj rc -v msplit.r -lmsg; rm msplit.obj rc -v mstop.r -lmsg; rm mstop.obj rc -v mtrace.r -lmsg; rm mtrace.obj rc -v nalias.r -lmsg; rm nalias.obj rc -v netdlv.r -lmsg; rm netdlv.obj rc -v notify.r -lmsg; rm notify.obj rc -v postmn.r -lmsg; rm postmn.obj rc -v rmtxeq.r -lmsg; rm rmtxeq.obj ratp1 decdef smtp.r | ratp2 >dmtprx.f netbld fc dmtprx dmtprx.f; rm dmtprx.obj dmtprx.f bigbld rc sndmsg.r; rm sndmsg.obj rc -v tc.r -lmsg; rm tc.obj rc -v tcadd.r -lmsg; rm tcadd.obj rc -v tcarch.r -lmsg; rm tcarch.obj rc -v users.r -lmsg; rm users.obj # VMS netbld rc vmstom vmstomsg.r # VMS rm vmstomsg.obj # VMS ratp1 vmsdef smtpxmt.r | ratp2 >vmtpxmt.f # VMS netbld fc vmtpxm vmtpxmt.f # VMS rm vmtpxmt.f vmtpxmt.obj #-h- mailsym.src 2485 asc 05-aug-83 17:15:05 sventek (joseph sventek) # token types for address scanner define(QUOTED_STRING,'"') define(COMMENT,'#') define(ATOM,'a') # other token types are the characters ',', ':', '@@', '<' and '>' # end of token types # defined symbols for logging in delivr and mailer define(L_NOLOG,0) # logging turned off define(L_INT,1) # log internal errors define(L_COMM,2) # log communication errors with other processes define(L_TRACE,3) # log trace messages (informative) define(L_BABBLE,4) # log non-critical babble define(L_DEFAULT,L_COMM) # default logging level initially define(LEVEL_NDX,1) # index for setlog define(COUNT_NDX,2) # index for setlog # end of logging symbols define(match1,ifelse($1,,imatch,imatch($1,1,$2))) define(MSG_HEADER,"@1@1") # first two characters of header line define(MAX_TOK,100) # maximum size of address tokens define(DEF_SIZE,1000) # maximum size of an alias definition define(KEY_SIZE,FILENAMESIZE) # size of encryption key define(HOST_SIZE,20) # max size of host name define(WAIT_HOUR,0) # hours between mflush sweeps define(WAIT_MINUTE,15) # minutes between mflush sweeps define(WAIT_SECOND,0) # seconds between mflush sweeps define(RIGHT_MARGIN,80) define(AGE_LIMIT,7) # limit of seven days in the system define(INCLUDE_CMSG_TABLE,common/cmsgtb/alitbl,adrtbl,hsttbl pointer alitbl, adrtbl, hsttbl) define(MAIL_PASSWORD,"Isildur's bane!") define(RELOAD_MESSAGE,"Reload") define(TERMINATE_MESSAGE,"Terminate") define(TRACE_MESSAGE,"Trace") define(MSGID_MESSAGE,"Message-Id") define(CHGNET_MESSAGE,"Change") define(MSTOP_LOCK,"~msg/mstop.lck") define(MFLUSH_LOCK,"~msg/mflush.lck") define(TC_SUFFIX,".tc") define(BND_SUFFIX,".bnd") define(NFO_SUFFIX,".nfo") define(NDX_SUFFIX,".ndx") define(MAIL_FROM_STR,"MAIL FROM:") define(RCPT_TO_STR,"RCPT TO:") define(DATA_STR,"DATA@n") define(ARRIVAL_TIME_STR,"ARRIVAL_TIME: ") # # Start of Operating system dependent definitions # include netlist # include site-specific network list define(MSG_SIZE,30) # size of message for sndmsg/rcvmsg define(SMTP_ERROR_FILE,"TT0:") # error file for SMTP Receivers define(LOCAL_HOST_NAME,"@@j") # local host name define(MEM_SIZE,1500) # size of dynamic storage in integers define(PB_SIZE,2000) # size of push back buffer in characters define(MAXHEADERS,50) # maximum number of headers for msg and msplit define(MAX_NO_TOPICS,50) # maximum number of tc topics # STATISTICS define(DO_STATISTICS,) # cause delivery system to log stats define(TC_DIRECTORY,"~msg/") # directory for tc files #-h- mflush.r 9172 asc 05-aug-83 17:15:08 sventek (joseph sventek) #-h- defns 58 asc 18-apr-82 07:09:57 v1.1 (sw-tools v1.1) include mailsym define(Mem_size,500) define(Ave_size,20) #-h- main 1049 asc 15-nov-82 08:49:52 tools (lblh csam sventek) DRIVER(mflush) integer nsec, junk integer sleep, assign, remove pointer listhd filedes fd filedes fcreat, fopen string pname "mflush" string logfil "~msg/mflush.log" string lockf MFLUSH_LOCK string mslock MSTOP_LOCK string endmsg "Mflush terminated by request at " call minit(pname) nsec = 60 * (60 * WAIT_HOUR + WAIT_MINUTE) + WAIT_SECOND repeat { junk = assign(logfil, ERROUT, APPEND) call setlog(LEVEL_NDX, L_DEFAULT) call setlog(COUNT_NDX, 0) if (fopen(mslock, READ, fd) != ERR) # file exists ==> must close down { call close(fd) call putlin(endmsg, ERROUT) call ptdate(ERROUT) call close(ERROUT) break } if (fcreat(lockf, WRITE, fd) != ERR) # create lock file { call putch('@n', fd) call close(fd) } call load(listhd) # load file names call mretry(listhd) call mretrn(listhd) for (i = 1; i <= 10; i = i + 1) # try to delete lock file 10 times { if (remove(lockf) == OK) break junk = sleep(1) } call close(ERROUT) junk = sleep(nsec) } DRETURN end #-h- load 840 asc 15-nov-82 08:49:53 tools (lblh csam sventek) subroutine load(listhd) pointer listhd, p, dsget integer opendr, desc, gdrprm, indexs, length character file(FILENAMESIZE) DS_DECL(Mem,Mem_size) string maildr "~msg/" string null "" string errdir "Cannot open ~msg/ directory" string retstr "return." string retry "retry." listhd = LAMBDA # empty list, initially call dsinit(Mem_size) # initialize dynamic storage if (opendr(maildr, desc) == ERR) # open ~msg/ { call errlog(null, direrr, L_INT) return } while (gdrprm(desc, file) != EOF) { call fold(file) if (indexs(file, retstr) == 2 | indexs(file, retry) == 2) { p = dsget(1 + (length(file) + CHAR_PER_INT) / CHAR_PER_INT) if (p == LAMBDA) break Mem(p) = listhd # relink list listhd = p # ... call scopy(file, 1, cMem, cvt_to_cptr(p+1)) } } call closdr(desc) return end #-h- mretrn 1095 asc 15-nov-82 09:14:17 tools (lblh csam sventek) subroutine mretrn(listhd) pointer listhd, p character file(FILENAMESIZE), buf(FILENAMESIZE), reason(MAXLINE), from(FILENAMESIZE) filedes in, fopen integer indexs, n, getlin, junk, remove, stat, retmsg DS_DECL(Mem, Mem_size) string maildr "~msg/" string retstr "return." string mailer "Mailer" string delivr "Delivr" string msg1 "Cannot open file for return: " string msg2 "File submitted for return: " string msg3 "Error in returning file: " for (p=listhd; p != LAMBDA; p=Mem(p)) { call scopy(cMem, cvt_to_cptr(p+1), buf, 1) if (indexs(buf, retstr) == 2) { call concat(maildr, buf, file) if (fopen(file, READ, in) == ERR) call errlog(msg1, file, L_COMM) else { n = getlin(reason, in) reason(n) = EOS if (buf(1) == 'm') call strcpy(mailer, from) else call strcpy(delivr, from) stat = retmsg(from, reason, in) call close(in) if (stat == OK) call errlog(msg2, file, L_BABBLE) else call errlog(msg3, file, L_TRACE) junk = remove(file) } } } return end #-h- mretry 888 asc 16-jun-83 13:34:47 sventek (joseph sventek) subroutine mretry(listhd) character file(FILENAMESIZE), bf(MAXLINE) pointer listhd, p integer indexs, sndmsg, msgage DS_DECL(Mem, Mem_size) string maildr "~msg/" string retry "retry." string delivr "delivr" string msg1 "Cannot contact delivr - file: " string msg2 "File submitted to delivr: " string areasn "Message is too old. " string freasn "Cannot get to host" for (p=listhd; p != LAMBDA; p=Mem(p)) { call scopy(cMem, cvt_to_cptr(p+1), bf, 1) if (indexs(bf, retry) == 2) { call concat(maildr, bf, file) if (bf(1) == 'f') # "failure" retry call tryret(file, bf, freasn) else if (msgage(file, bf) > AGE_LIMIT) { call errlog(areasn, bf, L_TRACE) call tryret(file, bf, areasn) } else if (sndmsg(delivr, file) == ERR) call errlog(msg1, file, L_COMM) else call errlog(msg2, file, L_BABBLE) } } return end #-h- retmsg 2960 asc 16-jun-83 13:34:49 sventek (joseph sventek) integer function retmsg(from, reason, in) character from(ARB), reason(ARB), file(FILENAMESIZE), bf(MAXLINE), to(MAX_TOK), host(HOST_SIZE), sender(MAX_TOK) integer junk, nadr, column, i, n, stat linepointer adrtop, msgtop filedes in, out ext_func integer note, getlin, match1, length, getwrd, sndmsg, rcvmsg, remove ext_func integer adrvld ext_func filedes fcreat string tmp "~tmp/" string tempf "mflush.tmp" string msg1 "Cannot create temp file: " string fromst MAIL_FROM_STR string mailer "mailer" string tost RCPT_TO_STR string datast DATA_STR string datstr "Date: " string frmstr "From: " string tos "To: " string defalt "default" string subjct "Subject: Undeliverable Mail" string reastr "Comment: reason for return -- " string affect "Comment: the affected addresses follow ..." string comstr "Comment: " string start "@nStart of returned message@n@n" string stop "@nEnd of returned message@n" string msg2 "Cannot contact mailer; file: " string msg3 "Error receiving message from mailer" string null "" stat = ERR junk = note(adrtop, in) call concat(tmp, tempf, file) if (fcreat(file, WRITE, out) == ERR) { call errlog(msg1, file, L_INT) return(stat) } nadr = 0 while (getlin(bf, in) != EOF) if (match1(bf, fromst) == YES) break else nadr = nadr + 1 junk = note(msgtop, in) call xtrpth(bf, bf) # fetch path call pthadr(bf, sender) # convert to name@host[@host]... if (adrvld(sender, from, reason, in) == ERR) call close(out) else { call angbrk(fromst, from, out) call angbrk(tost, bf, out) call putlnl(datast, out) call putlin(datstr, out) call ptdate(out) call putlin(frmstr, out) call putlin(from, out) call gthost(defalt, host) call putlnl(host, out) call putlnl(subjct, out) call angbrk(tos, bf, out) call putlin(reastr, out) call putlnl(reason, out) if (nadr > 0) { call putlnl(affect, out) call seek(adrtop, in) call putlin(comstr, out) column = length(comstr) + 1 for (i=1; i <= nadr; i=i+1) { n = getlin(bf, in) bf(n) = EOS call strcpy(bf, to) n = 1 call chcopy(' ', bf, n) call stcopy(to, 1, bf, n) if (i < nadr) call chcopy(',', bf, n) n = n - 1 if ((column + n) > RIGHT_MARGIN) { call putch('@n', out) call putlin(comstr, out) column = length(comstr) + 1 } call putlin(bf, out) column = column + n } call putch('@n', out) } call putlin(start, out) call seek(msgtop, in) while (getlin(bf, in) != EOF) { call scrypt(bf) # decrypt buffer call putch(' ', out) call putch(' ', out) call putlin(bf, out) } call putlin(stop, out) call close(out) if (sndmsg(mailer, file) == ERR) call errlog(msg2, file, L_COMM) else if (rcvmsg(to, bf) == ERR) call errlog(null, msg3, L_COMM) else stat = OK } junk = remove(file) return(stat) end #-h- tryret 1037 asc 15-nov-82 12:22:17 sventek (joseph sventek) subroutine tryret(file, bf, reason) character file(ARB), bf(ARB), reason(ARB), savfrm(MAXLINE) filedes in, out filedes open, fcreat, fopen integer junk, stat integer getlin, match1, retmsg, remove string temp "~msg/mflush.tmp" string msg0 "Cannot create temp file for return: " string arrstr ARRIVAL_TIME_STR string from "Delivr" string msg1 "Error returning file: " if (fopen(file, READ, in) != ERR) { if (fcreat(temp, WRITE, out) == ERR) { call errlog(msg0, temp, L_INT) call close(in) } else { junk = getlin(savfrm, in) while (getlin(bf, in) != EOF) if (match1(bf, arrstr) == YES) break else { call xtrpth(bf, bf) call putlnl(bf, out) } call putlnl(savfrm, out) call fcopy(in, out) call close(in) call close(out) in = open(temp, READ) stat = retmsg(from, reason, in) call close(in) junk = remove(temp) if (stat != OK) call errlog(msg1, file, L_TRACE) } junk = remove(file) } return end #-h- adrvld 629 asc 15-nov-82 08:49:57 tools (lblh csam sventek) integer function adrvld(sender, from, reason, in) character sender(ARB), from(ARB), reason(ARB) filedes in integer match1 integer status string mailer "mailer" string delivr "delivr" string tost "To: " string fromst "From: " string reasst "Reason: " string null "" string errmsg "Attempt to return mail to a Mailer of Delivr" if (match1(sender, mailer) == YES | match1(sender, delivr) == YES) { call errlog(null, errmsg, L_INT) call errlog(tost, sender, L_INT) call errlog(fromst, from, L_INT) call errlog(reasst, reason, L_INT) call fcopy(in, ERROUT) status = ERR } else status = OK return(status) end #-h- mretry.r 2283 asc 05-aug-83 17:15:12 sventek (joseph sventek) #-h- defns 16 asc 01-jul-82 11:24:28 j (sventek j) include mailsym #-h- main 780 asc 30-jun-82 15:58:40 j (sventek j) DRIVER(mretry) character file(FILENAMESIZE), user(USERSIZE) integer i, junk integer getarg, resbmt, remove, index string saved "dead.ltr" string pname "mretry?" string errmsg "Error resubmitting file: " call query("usage: mretry [file] ...") call minit(pname) call mailid(user) i = index(user, ' ') if (i > 0) user(i) = EOS call fold(user) for (i=1; getarg(i, file, FILENAMESIZE) != EOF; i=i+1) if (resbmt(file, user) == OK) junk = remove(file) else { call putlin(errmsg, ERROUT) call error(file) } if (i == 1) # default to ~home/dead.ltr { call homdir(file, LOCAL) call concat(file, saved, file) if (resbmt(file, user) == OK) junk = remove(file) else { call putlin(errmsg, ERROUT) call error(file) } } DRETURN end #-h- resbmt 1278 asc 22-oct-82 16:32:58 sventek (joseph sventek) integer function resbmt(file, user) character file(ARB), outfil(FILENAMESIZE), buf(MAXLINE), user(ARB), temp(MAXLINE) integer stat, rstat, junk integer sndmlr, getlin, equal, remove, match1, valfil filedes out, in, fcreat, fopen string seed "mrt" string hdr "@1@2@n" string fromst MAIL_FROM_STR call scratf(seed, outfil) if (fopen(file, READ, in) == ERR) stat = ERR else if (getlin(buf, in) == EOF) # empty file { call close(in) stat = OK } else if (equal(buf, hdr) == NO) # not correct format { call close(in) stat = ERR } else { repeat { if (fcreat(outfil, WRITE, out) == ERR) { stat = ERR break } stat = OK for (rstat=getlin(buf,in); rstat != EOF; rstat=getlin(buf,in)) { if (equal(buf, hdr) == YES) break if (match1(buf, fromst) == YES) { call xtrpth(buf, temp) call fold(temp) if (equal(temp, user) == NO) andif (valfil(user, temp) == ERR) { stat = ERR break } } call putlin(buf, out) } call close(out) if (stat == OK) stat = sndmlr(outfil) } until (stat == ERR | rstat == EOF) call close(in) junk = remove(outfil) } return(stat) end #-h- msg.r 51557 asc 19-oct-83 11:30:51 system (the system) #-h- defns 951 asc 13-jun-83 14:16:26 sventek (joseph sventek) include mailsym define(DELETE,'d') define(SAVE,'s') define(MSGNUMBERS,'0') define(SEPARATOR,':') define(NOCONFIRM,'n') define(PATSIZE,20) define(STATE_W,5) define(NUMB_W,3) define(SIZE_W,6) define(DATE_W,12) define(FROM_W,18) define(SUBJ_W,30) define(MSGNOCHAR,'#') define(MSGSIZECHAR,'*') define(SCRATCHSIZE,75) define(NOTIFY,YES) define(NONOTIFY,NO) define(HLPPTRSIZE,30) define(PAGESIZE,22) define(NOPAGING,-1) define(LISTHEADERS,YES) define(NOLISTHEADERS,NO) define(NULLCHAR,8%200) # null with high bit set, so != EOS define(MAXPAD,7) define(MINPAD,0) define(DEFPAD,5) define(EOT,SUB) # ^Z define(LINEDELETE,NAK) # ^U define(RETYPELINE,DC2) # ^R define(D_MASK,2%1) # bit marking message as deleted define(A_MASK,2%10) # message has been answered define(C_MASK,2%100) # receipt has been sent (certified) define(N_MASK,2%1000) # message is new define(R_MASK,2%10000) # receipt will be sent to sender when read #-h- main 613 asc 16-jun-83 13:41:55 sventek (joseph sventek) DRIVER(msg) integer stmode, status, msgcmd character c, clower, getch include chdrs include cmsg string pstr "<- " call query("usage: msg [-fn] [-p[n]] [file]") rawin = stmode(STDIN, RARE) rawout = stmode(STDOUT, RARE) call msgint repeat { call Mputc('@n') call Mptlin(pstr) repeat { c = getch(c, STDIN) if (c == EOT | c == EOF) break if (c == CR | c == ' ') c = 'n' } until (c != '@n') if (c == EOT | c == EOF) break c = clower(c) status = msgcmd(c) } until (status == EOF) call msgend return end #-h- banner 217 asc 29-jun-82 08:25:21 j (sventek j) subroutine banner integer mrkhlp external ptmlin include cmhelp string bannst "banner" if (mrkhlp(hlpint, hlpptr, bannst, hlpscr) == OK) call puthlp(hlpint, hlpscr, bannst, STDOUT, ptmlin) return end #-h- collap 198 asc 29-jun-82 08:25:23 j (sventek j) subroutine collap(buf) character buf(ARB) integer i integer index i = index(buf, '@n') if (i > 0) buf(i) = EOS i = index(buf, ' ') + 1 call skipbl(buf, i) call scopy(buf, i, buf, 1) return end #-h- curfil 154 asc 01-nov-82 20:39:38 sventek (joseph sventek) subroutine curfil(int) include cmsg string filstr " file '" call ptmlin(filstr, int) call ptmlin(file, int) call mputch('@'', int) return end #-h- delemf 274 asc 09-feb-83 09:46:37 sventek (joseph sventek) subroutine delemf(linara) integer linara(MAXHEADERS), i, n integer inbset include chdrs include cmsg for (i=1; i < MAXHEADERS & linara(i) != 0; i=i+1) { n = linara(i) hstate(n) = inbset(hstate(n), D_MASK) } if (i > 1) ifmods = YES return end #-h- doansw 1454 asc 14-mar-83 16:21:42 sventek (joseph sventek) integer function doansw(x) character x integer n, i, junk integer gmsgno, scnhdr, remove, inbset filedes fcreat, out include chdrs include cmsg include msgscr include crest string ans "ans" string sndmsg "sndmsg" string minust " -t" string minusr " @"-rYour message " string dated "dated " string msgids "Message-Id:" string spnerr " Error spawning sndmsg " if (gmsgno(n) == ERR) doansw = ERR else { call scratf(ans, tfile) if (fcreat(tfile, WRITE, out) != ERR) { call grplad(n, rest) # get reply address call putlnl(rest, out) call close(out) i = 1 call stcopy(sndmsg, 1, buf, i) call stcopy(minust, 1, buf, i) call stcopy(tfile, 1, buf, i) call gensub(n, buf, i) # generate subject line call stcopy(minusr, 1, buf, i) if (scnhdr(haddr(n), msgids, rest, unit) == YES) # locate Message-Id: { call collap(rest) call stcopy(rest, 1, buf, i) call chcopy(' ', buf, i) } call stcopy(dated, 1, buf, i) call gthlin(hdate(n), rest) call canond(rest) call stcopy(rest, 1, buf, i) call chcopy('"', buf, i) if (spwnit(buf) == ERR) { doansw = ERR call Mptlin(spnerr) } else { doansw = OK hstate(n) = inbset(hstate(n), A_MASK) ifmods = YES } junk = remove(tfile) } else doansw = ERR } return end #-h- doback 291 asc 14-mar-83 16:21:44 sventek (joseph sventek) integer function doback(linara) integer linara(MAXHEADERS) include cmsg string errmsg "cannot backup past message 1" if (curmsg > 1) { curmsg = curmsg - 1 call onemsg(curmsg) doback = OK } else { call Mptlin(errmsg) doback = ERR } return end #-h- docurr 351 asc 14-mar-83 16:21:45 sventek (joseph sventek) integer function docurr(x) character x, temp(5) integer itoc integer junk include cmsg string ofs " of" string msgs " messages in" data temp(1) /' '/ junk = itoc(curmsg, temp(2), 4) call Mptlin(temp) call Mptlin(ofs) junk = itoc(nmsgs, temp(2), 4) call Mptlin(temp) call Mptlin(msgs) call curfil(STDOUT) docurr = OK return end #-h- dodele 196 asc 14-mar-83 16:21:46 sventek (joseph sventek) integer function dodele(linara) integer linara(MAXHEADERS) integer msgseq if (msgseq(linara) == ERR) dodele = ERR else { call delemf(linara) dodele = OK } return end #-h- doexit 334 asc 14-mar-83 16:21:47 sventek (joseph sventek) integer function doexit(linara) integer linara(MAXHEADERS), status integer savemf, gtconf string errmsg "@n? Can't update mail file." call curfil(STDOUT) if (gtconf(status) == NO) doexit = ERR else if (savemf(linara, 'e') == ERR) { call Mptlin(errmsg) doexit = ERR } else doexit = EOF return end #-h- doforw 902 asc 19-oct-83 09:42:18 sventek (joseph sventek) integer function doforw(linara) integer linara(MAXHEADERS), i, junk integer msgseq, spwnit, remove, putmf filedes int, fcreat include msgscr string fwd "fwd" string start "----- Start of forwarded message[s] -----" string newlin "@n" string stop "------ End of forwarded message[s] ------" string sndmsg "sndmsg" string minusm " -m" string spnerr " Error spawning sndmsg!" if (msgseq(linara) == ERR) doforw = ERR else { call scratf(fwd, tfile) if (fcreat(tfile, WRITE, int) != ERR) { call ptmlin(start, int) junk = putmf(newlin, linara, int, NOPAGING) call ptmlin(stop, int) call close(int) i = 1 call stcopy(sndmsg, 1, buf, i) call gensub(linara(1), buf, i) call stcopy(minusm, 1, buf, i) call scopy(tfile, 1, buf, i) if (spwnit(buf) == ERR) call Mptlin(spnerr) junk = remove(tfile) doforw = OK } else doforw = ERR } return end #-h- dogoto 212 asc 14-mar-83 16:21:49 sventek (joseph sventek) integer function dogoto(x) character x integer gmsgno integer n include cmsg if (gmsgno(n) == ERR) dogoto = ERR else { curmsg = n call onemsg(curmsg) dogoto = OK } return end #-h- dohead 233 asc 14-mar-83 16:21:50 sventek (joseph sventek) integer function dohead(linara) integer linara(MAXHEADERS) integer msgseq include cmsg if (msgseq(linara) == ERR) dohead = ERR else { call headmf('@n', linara, STDOUT, pagesz) dohead = OK } return end #-h- dohelp 711 asc 14-mar-83 16:21:51 sventek (joseph sventek) integer function dohelp(x) linepointer hlptmp(2) character x integer mrkhlp, gtcont, ptreq integer j, i include cmhelp include cmsg external ptmlin string summar "%" string errmsg " No help available." string null "" if (mrkhlp(hlpint, hlpptr, summar, hlpscr) == ERR) { call Mptlin(errmsg) dohelp = ERR } else { call ptrcpy(NULLPOINTER, hlptmp(2)) call Mputc('@n') j = 0 for (i=1; ptreq (hlpscr(i), NULLPOINTER) == NO; i=i+1) { if (pagesz > 0 & j >= pagesz) if (gtcont(null) == NO) break else j = 0 call ptrcpy(hlpscr(i), hlptmp(1)) call puthlp(hlpint, hlptmp, summar, STDOUT, ptmlin) j = j + 1 } dohelp = OK } return end #-h- doinfo 715 asc 14-mar-83 16:21:52 sventek (joseph sventek) integer function doinfo(x) character x, c character clower, getch integer mrkhlp external ptmlin include cmhelp include msgscr string news "news" string intr "intr" string help "help" string errmsg " No information available!" c = clower(getch(c,STDIN)) call Mputc(c) call Mputc('@n') if (c == '?') call strcpy(help, scrfil) else if (c == '#') call strcpy(news, scrfil) else if (c == '%') call strcpy(intr, scrfil) else { scrfil(1) = c scrfil(2) = EOS } if (mrkhlp(hlpint, hlpptr, scrfil, hlpscr) == ERR) { call Mptlin(errmsg) doinfo = ERR } else { call puthlp(hlpint, hlpscr, scrfil, STDOUT, ptmlin) doinfo = OK } return end #-h- dointr 418 asc 14-mar-83 16:21:53 sventek (joseph sventek) integer function dointr(x) character x integer mrkhlp include cmhelp external ptmlin string intr "intr" string errmsg "? Sorry, no introduction available; consult the MSG primer." if (mrkhlp(hlpint, hlpptr, intr, hlpscr) == ERR) { call Mptlin(errmsg) dointr = ERR } else { call Mputc('@n') call puthlp(hlpint, hlpscr, intr, STDOUT, ptmlin) dointr = OK } return end #-h- dojump 314 asc 14-mar-83 16:21:54 sventek (joseph sventek) integer function dojump(x) character x integer gtconf, spwnit integer i include msgscr string sh "sh" string spnerr " Error spawning shell!" if (gtconf(i) == YES) { call strcpy(sh, buf) if (spwnit(buf) == ERR) call Mptlin(spnerr) dojump = OK } else dojump = ERR return end #-h- dolist 798 asc 19-oct-83 09:42:20 sventek (joseph sventek) integer function dolist(linara) integer linara(MAXHEADERS), junk integer msgseq, getmf, putmf filedes int, fcreat include msgscr include cmsg include chdrs include cfiltr string ons "on" string lispat "@f--- message #, * characters ---" string errmsg " Error listing mail on " if (msgseq(linara) == ERR) dolist = ERR else { call Mputc('@n') call Mptlin(ons) if (getmf(scrfil) <= 0) dolist = ERR else { if (fcreat(scrfil, WRITE, int) != ERR) { call headmf(FF, linara, int, NOPAGING) filter = YES junk = putmf(lispat, linara, int, NOPAGING) filter = NO call close(int) dolist = OK } else dolist = ERR } if (dolist == ERR) { call Mptlin(errmsg) call Mptlin(scrfil) } } return end #-h- domove 669 asc 19-oct-83 09:42:21 sventek (joseph sventek) integer function domove(linara) integer linara(MAXHEADERS), int, junk integer msgseq, cre8mf, getmf, putmf include chdrs include cmsg include msgscr string intos "into" string errmsg " Error moving mail into " if (msgseq(linara) == ERR) domove = ERR else { call Mputc('@n') call Mptlin(intos) if (getmf(scrfil) <= 0) domove = ERR else { int = cre8mf(scrfil, APPEND) if (int != ERR) { junk = putmf(hdrpat, linara, int, NOPAGING) call close(int) call delemf(linara) domove = OK } else domove = ERR } if (domove == ERR) { call Mptlin(errmsg) call Mptlin(scrfil) } } return end #-h- donews 379 asc 14-mar-83 16:21:57 sventek (joseph sventek) integer function donews(x) character x integer mrkhlp include cmhelp external ptmlin string news "news" string errmsg " No news available." if (mrkhlp(hlpint, hlpptr, news, hlpscr) == ERR) { call Mptlin(errmsg) donews = ERR } else { call Mputc('@n') call puthlp(hlpint, hlpscr, news, STDOUT, ptmlin) donews = OK } return end #-h- donext 285 asc 14-mar-83 16:21:58 sventek (joseph sventek) integer function donext(linara) integer linara(MAXHEADERS) include cmsg string errmsg " no more messages!" if (curmsg < nmsgs) { curmsg = curmsg + 1 call onemsg(curmsg) donext = OK } else { call Mptlin(errmsg) donext = ERR } return end #-h- doover 434 asc 14-mar-83 16:21:59 sventek (joseph sventek) integer function doover(linara) integer linara(ARB), status integer savemf, readmf, gtconf include cmsg string errmsg " Error overwriting file!" call curfil(STDOUT) if (gtconf(status) == NO) doover = ERR else if (savemf(linara, 'o') == ERR) doover = ERR else if (readmf(file, NONOTIFY, LISTHEADERS, linara) == ERR) doover = ERR else doover = OK if (doover == ERR) call Mptlin(errmsg) return end #-h- doput 639 asc 19-oct-83 09:42:23 sventek (joseph sventek) integer function doput(linara) integer linara(MAXHEADERS), int, junk integer msgseq, cre8mf, getmf, putmf include chdrs include cmsg include msgscr string intos "into" string errmsg " Error putting mail into " if (msgseq(linara) == ERR) doput = ERR else { call Mputc('@n') call Mptlin(intos) if (getmf(scrfil) <= 0) doput = ERR else { int = cre8mf(scrfil, APPEND) if (int != ERR) { junk = putmf(hdrpat, linara, int, NOPAGING) call close(int) doput = OK } else doput = ERR } if (doput == ERR) { call Mptlin(errmsg) call Mptlin(scrfil) } } return end #-h- doquit 282 asc 14-mar-83 16:22:02 sventek (joseph sventek) integer function doquit(x) character x integer gtconf integer status include chdrs include cmsg if (ifmods == NO) # no mods were made doquit = EOF else if (gtconf(status) == YES) # quit is confirmed doquit = EOF else # error doquit = ERR return end #-h- doread 895 asc 14-mar-83 16:22:02 sventek (joseph sventek) integer function doread(linara) integer linara(MAXHEADERS), status integer readmf, getmf, gtconf, savemf include msgscr include cmsg include chdrs string errmsg " Error reading file!" string updstr "@nUpdate" string first " first?" if (getmf(tfile) <= 0) doread = ERR else { if (ifmods == YES) # there have been changes { call Mptlin(updstr) # update file first? call curfil(STDOUT) call Mptlin(first) if (gtconf(status) == YES) # user wants to update status = savemf(linara, 'o') # update as for overwrite } else status = OK if (status == ERR) doread = ERR else if (readmf(tfile, NOTIFY, LISTHEADERS, linara) == ERR) doread = ERR else { defalt = NO doread = OK } } if (doread == ERR) call Mptlin(errmsg) return end #-h- dosequ 479 asc 29-jun-82 08:26:01 j (sventek j) integer function dosequ(x) character x integer mrkhlp include cmhelp external ptmlin string intstr "? may be any of the following:" string sequ "sequ" string errmsg "? Sorry, no help available; consult the MSG primer." call Mptlin(intstr) if (mrkhlp(hlpint, hlpptr, sequ, hlpscr) == ERR) { call Mptlin(errmsg) dosequ = ERR } else { call Mputc('@n') call puthlp(hlpint, hlpscr, sequ, STDOUT, ptmlin) dosequ = OK } return end #-h- dosndm 324 asc 23-mar-83 10:32:43 sventek (joseph sventek) integer function dosndm(x) character x integer gtconf, spwnit integer i include msgscr string str "sndmsg" string spnerr " Error spawning sndmsg!" if (gtconf(i) == YES) { call strcpy(str, buf) if (spwnit(buf) == ERR) call Mptlin(spnerr) dosndm = OK } else dosndm = ERR return end #-h- dotype 380 asc 19-oct-83 09:42:25 sventek (joseph sventek) integer function dotype(linara, iffilt) integer linara(MAXHEADERS), iffilt integer msgseq, putmf include cmsg include cfiltr string typhdr "@n(message #, * characters)" if (msgseq(linara) == ERR) dotype = ERR else { call Mputc('@n') filter = iffilt curmsg = putmf(typhdr, linara, STDOUT, pagesz) filter = NO dotype = OK } return end #-h- dounde 320 asc 14-mar-83 16:22:06 sventek (joseph sventek) integer function dounde(linara) integer linara(MAXHEADERS), i integer msgseq, inbclr include chdrs if (msgseq(linara) == ERR) dounde = ERR else { for (i=1; i < MAXHEADERS & linara(i) != 0; i=i+1) { j = linara(i) hstate(j) = inbclr(hstate(j), D_MASK) } dounde = OK } return end #-h- exptab 359 asc 29-jun-82 08:26:09 j (sventek j) subroutine exptab(buf) character buf(ARB), blanks(10) integer i, j, k i = 1 while (buf(i) != EOS) if (buf(i) == '@t') { j = 1 k = i repeat { blanks(j) = ' ' j = j + 1 k = k + 1 if (mod(k,8) == 1) break } blanks(j) = EOS call chrstr(buf, i, blanks) } else i = i + 1 return end #-h- fstate 564 asc 13-jun-83 14:16:34 sventek (joseph sventek) # fstate - format state information into buf, return length integer function fstate(statev, buf) character buf(ARB), c integer statev integer i integer inbtst for (i = 1; i <= 4; i = i + 1) { c = ' ' switch (i) { case 1: if (inbtst(statev, A_MASK) > 0) c = 'A' case 2: if (inbtst(statev, D_MASK) > 0) c = 'D' case 3: if (inbtst(statev, N_MASK) > 0) c = 'N' case 4: if (inbtst(statev, arith(C_MASK,+,R_MASK)) == R_MASK) c = 'R' } buf(i) = c } buf(i) = EOS return(i-1) end #-h- fstats 485 asc 13-jun-83 14:16:35 sventek (joseph sventek) # fstats - function to format the X-ST-Status: line integer function fstats(statev, buf) character buf(ARB) integer statev integer i, last string hdr "X-ST-Status: " i = 1 call stcopy(hdr, 1, buf, i) last = i if (inbtst(statev, A_MASK) > 0) call chcopy('A', buf, i) if (inbtst(statev, C_MASK) > 0) call chcopy('C', buf, i) if (inbtst(statev, N_MASK) > 0) call chcopy('N', buf, i) if (i > last) call chcopy('@n', buf, i) else { i = 1 buf(1) = EOS } return (i-1) end #-h- gensub 490 asc 09-feb-83 08:47:15 sventek (joseph sventek) subroutine gensub(n, buf, i) character c, buf(ARB) integer n, i integer index, match1 include chdrs include crest string minuss "-s" string restr "Re: " call gthlin(hsubj(n), rest) if (rest(1) == EOS) return if (index(rest, '"') > 0) # must use '@'' c = '@'' else c = '"' call chcopy(' ', buf, i) call chcopy(c, buf, i) call stcopy(minuss, 1, buf, i) if (match1(rest, restr) == NO) call stcopy(restr, 1, buf, i) call stcopy(rest, 1, buf, i) call chcopy(c, buf, i) return end #-h- getmf 369 asc 29-jun-82 08:26:11 j (sventek j) integer function getmf(file) character file(ARB), trmara(4) character gtrwln integer length integer i string str " file name: " data trmara/CR, LF, ESC, EOS/ call Mptlin(str) if (gtrwln(file, 1, STDIN, STDOUT, trmara) == ESC) file(1) = EOS call Mputc(' ') i = 1 call skipbl(file, i) call scopy(file, i, file, 1) getmf = length(file) return end #-h- gtrwln 827 asc 06-jan-83 11:15:43 sventek (joseph sventek) character function gtrwln(buf, start, in, out, trmara) integer in, out, i, start integer index character buf(ARB), trmara(ARB), c character getch string escstr "" string bsblbs "@b @b" string notstr "^R@r@l" i = start repeat { c = getch(c, in) if (index(trmara, c) > 0) break if (c == BS | c == RUBOUT) { if (i > 1) { call putlin(bsblbs, out) i = i - 1 } } else if (c == LINEDELETE) for ( ; i > 1; i = i - 1) call putlin(bsblbs, out) else if (c == RETYPELINE) { if (i > 1) { call putlin(notstr, out) buf(i) = EOS call putlin(buf, out) } } else { buf(i) = c i = i + 1 call putch(c, out) } } buf(i) = EOS if (c == ESC) call putlin(escstr, out) return(c) end #-h- gmsgno 1026 asc 09-feb-83 13:15:02 sventek (joseph sventek) integer function gmsgno(n) integer n, i integer ctoi character c, trmara(4) character clower, getch, type, gtrwln include cmsg include msgscr string str " message number: " string first "first" string last "last" string currnt "current" string errmsg " invalid message number!" data trmara /CR, LF, ESC, EOS/ call Mptlin(str) c = clower(getch(c, STDIN)) if (c == 'f') { call Mptlin(first) n = 1 } else if (c == 'l') { call Mptlin(last) n = nmsgs } else if (c == CR | c == LF | c == 'c') { call Mptlin(currnt) n = curmsg } else if (type(c) == DIGIT) { scrfil(1) = c call Mputc(c) if (gtrwln(scrfil, 2, STDIN, STDOUT, trmara) == ESC) n = 0 else { i = 1 n = ctoi(scrfil, i) if (scrfil(i) != EOS) n = 0 } } else if (c == ESC) n = 0 else { call Mputc(c) n = 0 } if (n <= 0 | n > nmsgs) { call Mptlin(errmsg) n = ERR } return(n) end #-h- grplad 535 asc 09-feb-83 11:06:54 sventek (joseph sventek) # grplad - generate reply address from message n subroutine grplad(n, addr) character addr(ARB) integer n integer found integer scnhdr include chdrs include cmsg include msgscr string replst "reply-to:" string retpth "Return-path:" found = scnhdr(haddr(n), replst, buf, unit) # locate Reply-To: field if (found == NO) # none found found = scnhdr(haddr(n), retpth, buf, unit) # locate Return-Path: if (found == NO) call gthlin(hfrom(n), addr) else { call strcpy(buf, addr) call collap(addr) } return end #-h- gseqno 1923 asc 06-jan-83 11:15:45 sventek (joseph sventek) integer function gseqno(c, linara) character c, text(SCRATCHSIZE), trmn8r, trmara(5), sepr8r(3), skpstr(8), bsblbs(4) character gtrwln, getch integer i, j, linara(MAXHEADERS), start, stop, dif, k, status, ctr integer ctoi, index, type include cmsg data trmara/CR, LF, ESC, ',', EOS/ data sepr8r/':', '-', EOS/ data skpstr/CR, LF, ' ', '@t', ',', BS, RUBOUT, EOS/ data bsblbs/BS, ' ', BS, EOS/ j = 1 status = OK repeat { text(1) = c call Mputc(c) trmn8r = gtrwln(text, 2, STDIN, STDOUT, trmara) if (trmn8r == ',') call Mputc(',') else if (trmn8r == ESC) { status = ERR break } i = 1 start = ctoi(text, i) if (start <= 0 | start > nmsgs) { status = ERR break } call skipbl(text, i) if (text(i) == EOS) { linara(j) = start j = j + 1 } else if (index(sepr8r, text(i)) > 0) { i = i + 1 if (text(i) == EOS) # user specified n- | n: stop = nmsgs else stop = ctoi(text, i) if (stop <= 0 | stop > nmsgs) { status = ERR break } if (stop >= start) dif = 1 else dif = -1 stop = stop + dif for (k=start; k != stop; k=k+dif) { linara(j) = k j = j + 1 } } else { status = ERR break } if (trmn8r == ',') { ctr = 1 for (c=getch(c,STDIN); index(skpstr,c) > 0; c=getch(c,STDIN)) if (c == BS | c == RUBOUT) { if (ctr > 1) { call Mptlin(bsblbs) ctr = ctr - 1 } } else { call Mputc(c) if (c == CR | c == LF) ctr = 1 else ctr = ctr + 1 } } if (type(c) != DIGIT) { status = ERR break } } until (trmn8r != ',') if (status == ERR) j = 1 linara(j) = 0 gseqno = status return end #-h- gstate 703 asc 13-jun-83 14:16:38 sventek (joseph sventek) # fill in state vector from X-ST-* header lines subroutine gstate(buf, statev) character buf(ARB) integer statev integer i, m integer match1, inbset string status "Status:" string rcptst "Return-Receipt-Requested:" call scopy(buf, 6, buf, 1) # collapse out X-ST- call fold(buf) if (match1(buf, status) == YES) # found X-ST-Status: { i = 1 call skipto(buf, i, ' ') call skipbl(buf, i) while (buf(i) != EOS) { switch (buf(i)) { case 'a': m = A_MASK case 'c': m = C_MASK case 'n': m = N_MASK default: m = 0 } statev = inbset(statev, m) i = i + 1 } } else if (match1(buf, rcptst) == YES) statev = inbset(statev, R_MASK) return end #-h- gtconf 310 asc 29-jun-82 08:26:22 j (sventek j) integer function gtconf(status) integer status character c character clower, getch string confst " [type SPACE to confirm] " call Mptlin(confst) c = clower(getch(c, STDIN)) if (c != CR & c != LF) call Mputc(c) if (c == ' ') status = YES else status = NO gtconf = status return end #-h- gtcont 356 asc 29-jun-82 08:26:24 j (sventek j) integer function gtcont(strng) integer index character c, strng(ARB) character getch string str "[type SPACE to continue]" string constr " " if (strng(1) == EOS) call Mptlin(str) else call Mptlin(strng) c = getch(c, STDIN) if (index(constr, c) > 0) { call Mputc('@n') gtcont = YES } else gtcont = NO return end #-h- gthlin 267 asc 29-jun-82 08:26:25 j (sventek j) subroutine gthlin(addr, buf) linepointer addr character buf(MAXLINE) integer junk integer ptreq, getlin include cmsg if (ptreq(addr, NULLPOINTER) == YES) buf(1) = EOS else { call seek(addr, unit) junk = getlin(buf, unit) call collap(buf) } return end #-h- gthptr 2636 asc 15-feb-83 08:01:20 sventek (joseph sventek) subroutine gthptr(in) integer i, getlin, match1, equal, n, j, index, in, type, ptreq, eofhdr integer junk, note linepointer temp, lp include chdrs include cmsg include msgscr include csize string errstr "Too many messages!" string fromst "from:" string retpth "return-path:" string subjst "subject:" string datest "date:" string xsthdr "X-ST-" i = 1 repeat { if (getlin(buf, in) == EOF) break call putlin(buf, unit) if (equal(buf, hdrpat) == YES) { if (i >= MAXHEADERS) { call Mputc('@n') call Mptlin(errstr) call msgend } junk = note(temp, in) # note position in input file junk = note(haddr(i), unit) # note position in output file call ptrcpy(NULLPOINTER, hfrom(i)) call ptrcpy(NULLPOINTER, hdate(i)) call ptrcpy(NULLPOINTER, hsubj(i)) call ptrcpy(NULLPOINTER, htext(i)) hstate(i) = 0 junk = note(lp, unit) initdi(size) initdi(incs) eofhdr = NO for (n=getlin(buf,in); n != EOF; n=getlin(buf,in)) { if (equal(buf, hdrpat) == YES) break call putlin(buf, unit) # copy line to temp file if (eofhdr == NO) # still processing header { if (buf(1) == '@n') # end of header { eofhdr = YES call ptrcpy(lp, htext(i)) } else { if (ptreq(hfrom(i), NULLPOINTER) == YES) if (match1(buf, fromst) == YES) call ptrcpy(lp, hfrom(i)) else if (match1(buf, retpth) == YES) call ptrcpy(lp, hfrom(i)) if (ptreq(hdate(i), NULLPOINTER) == YES) if (match1(buf, datest) == YES) call ptrcpy(lp, hdate(i)) if (ptreq(hsubj(i), NULLPOINTER) == YES) if (match1(buf, subjst) == YES) call ptrcpy(lp, hsubj(i)) if (match1(buf, xsthdr) == YES) call gstate(buf, hstate(i)) } } incs(2) = n adddi(incs, size) junk = note(temp, in) junk = note(lp, unit) } hsize(1, i) = size(1) hsize(2, i) = size(2) call seek(temp, in) i = i + 1 } } nmsgs = i - 1 return end #-h- hdrchk 558 asc 09-feb-83 14:37:51 sventek (joseph sventek) integer function hdrchk(buf) character buf(ARB) integer result integer match1 include cfiltr string rcvd "Received:" string xtra "X-ST-" string stat "X-ST-Status:" string path "Return-path:" result = YES # assume line OK if (match1(buf, stat) == YES) # always eliminate Status header line result = NO else if (filter == YES) # only perform checks if dotype or onemsg { if (match1(buf, rcvd) == YES) result = NO else if (match1(buf, xtra) == YES) result = NO else if (match1(buf, path) == YES) result = NO } return(result) end #-h- headmf 390 asc 01-jul-82 16:20:37 j (sventek j) subroutine headmf(ch, linara, int, page) character ch integer linara(MAXHEADERS), int, i, page, j integer gtcont string null "" if (ch != EOS) call mputch(ch, int) j = 0 for (i=1; i < MAXHEADERS & linara(i) != 0; i=i+1) { if (page > 0 & j >= page) if (gtcont(null) == NO) break else j = 0 call puthdr(linara(i), int) j = j + 1 } return end #-h- inimsh 340 asc 01-jul-82 16:15:16 j (sventek j) subroutine inimsh integer inihlp include cmhelp include msgscr string errmsg "? Error: file `~msg/msghlp' is missing or inaccessable." string msghlp "msghlp" call getdir(MSGDIRECTORY, LOCAL, scrfil) call concat(scrfil, msghlp, scrfil) if( inihlp(scrfil, hlpptr, HLPPTRSIZE, hlpint) == ERR ) call error(errmsg) return end #-h- matchs 194 asc 09-feb-83 08:43:11 sventek (joseph sventek) integer function matchs(buf, pat) character buf(ARB), pat(ARB) integer i integer imatch for (i = 1; buf(i) != EOS; i = i + 1) if (imatch(buf, i, pat) == YES) return(YES) return(NO) end #-h- mfsave 700 asc 19-oct-83 09:42:31 sventek (joseph sventek) integer function mfsave(outfil, access, linara, ifnot) character outfil(FILENAMESIZE) integer access, linara(MAXHEADERS), ifnot, int, j, i, junk integer cre8mf, inbtst, putmf include cmsg include chdrs string savstr "updating..." int = cre8mf(outfil, access) if (int != ERR) { if (ifnot == NOTIFY) { call Mputc('@n') call Mptlin(savstr) } j = 1 for (i=1; i <= nmsgs; i=i+1) if (inbtst(hstate(i), D_MASK) == 0) { linara(j) = i j = j + 1 } linara(j) = 0 if (access != APPEND) call putch('@n', int) junk = putmf(hdrpat, linara, int, NOPAGING) call close(int) mfsave = OK } else mfsave = ERR return end #-h- mptlin 81 asc 29-jun-82 08:28:22 j (sventek j) subroutine Mptlin(buf) character buf(ARB) call ptmlin(buf, STDOUT) return end #-h- mputc 69 asc 29-jun-82 08:28:23 j (sventek j) subroutine Mputc(c) character c call mputch(c, STDOUT) return end #-h- mputch 221 asc 29-jun-82 08:26:39 j (sventek j) subroutine mputch(c, int) integer int, raw character c include cmsg include ccrlf if (int == STDOUT & rawout != COOKED & (c == CR | c == LF)) call putlin(crlf, int) else call putch(c, int) return end #-h- msgcmd 2523 asc 26-jul-83 10:12:12 sventek (joseph sventek) undefine(RELOAD_MESSAGE) undefine(TERMINATE_MESSAGE) undefine(TRACE_MESSAGE) undefine(MSGID_MESSAGE) undefine(CHGNET_MESSAGE) define(b_l,1) define(NCMDS,0) define(s_e,string $1 $2; equivalence (cmdbuf(b_l),$1(1)) mdefine($(NCMDS$),incr(NCMDS)) mdefine($(b_l$),arith(b_l,+,arith(lentok($2),-,1)))) integer function msgcmd(c) integer i, j character c integer doansw, doback, docurr, dodele, doexit, doforw, doinfo, dogoto, dohead, dojump, dolist, domove, donext, doover, doput, doquit, doread, dosndm, dotype, dounde, donews, dohelp, dointr include cmline include msgscr s_e(ast,"answer") s_e(bst,"backing up - previous message is:") s_e(cst,"current message is") s_e(dst,"delete") s_e(est,"exit and update old") s_e(fst,"forward") s_e(gst,"go to") s_e(hst,"headers") s_e(ist,"information - type command character: ") s_e(jst,"jump into shell") s_e(lst,"list") s_e(mst,"move") s_e(nst,"next message is:") s_e(ost,"overwrite old") s_e(pst,"put") s_e(qst,"quit") s_e(rst,"read") s_e(sst,"sndmsg") s_e(tst,"type") s_e(ust,"undelete") s_e(zst,"zap") s_e(helpst,"? MSG Help") s_e(intrst,"% Introduction to MSG") s_e(newsst,"# MSG News") character cmdbuf(arith(b_l,-,1)) string estr " ? No such command. [Type '?' for help]" j = 1 for (i = 1; i <= NCMDS; i = i + 1) if (c == cmdbuf(j)) break else { while (cmdbuf(j) != EOS) j = j + 1 j = j + 1 } if (i > NCMDS) # invalid command { call Mputc(c) call Mptlin(estr) return(ERR) } call scopy(cmdbuf, j, buf, 1) # fetch string call Mptlin(buf) # output echo string switch (c) { case 'a': msgcmd = doansw(c) case 'b': msgcmd = doback(linara) case 'c': msgcmd = docurr(c) case 'd': msgcmd = dodele(linara) case 'e': msgcmd = doexit(linara) case 'f': msgcmd = doforw(linara) case 'g': msgcmd = dogoto(c) case 'h': msgcmd = dohead(linara) case 'i': msgcmd = doinfo(c) case 'j': msgcmd = dojump(c) case 'l': msgcmd = dolist(linara) case 'm': msgcmd = domove(linara) case 'n': msgcmd = donext(linara) case 'o': msgcmd = doover(linara) case 'p': msgcmd = doput(linara) case 'q': msgcmd = doquit(c) case 'r': msgcmd = doread(linara) case 's': msgcmd = dosndm(c) case 't': msgcmd = dotype(linara, YES) # filtered type case 'u': msgcmd = dounde(linara) case 'z': msgcmd = dotype(linara, NO) # literal-type (AKA zap) case '#': msgcmd = donews(c) case '?': msgcmd = dohelp(c) case '%': msgcmd = dointr(c) } return end #-h- msgend 154 asc 29-jun-82 08:26:43 j (sventek j) subroutine msgend integer junk integer remove include cmsg call Mputc('@n') call close(unit) junk = remove(scrat) call endst(OK) return end #-h- msgint 1517 asc 25-jul-83 15:04:52 sventek (joseph sventek) subroutine msgint character clower character c integer i, j, pad, lockid integer getarg, readmf include chdrs include cmsg include ccrlf include cmhelp include msgscr include cmline include cfiltr string mymail "mymail" string msg "msg" filter = NO # initialize filter flag if (rawin != COOKED & rawout != COOKED) pagesz = PAGESIZE else pagesz = NOPAGING hdrpat(1) = 1 hdrpat(2) = 1 hdrpat(3) = '@n' hdrpat(4) = EOS call inimsh call homdir(home, LOCAL) call scratf(msg, scrat) unit = ERR call concat(home, mymail, scrfil) defalt = YES pad = DEFPAD for (i=1; getarg(i, buf, FILENAMESIZE) != EOF; i=i+1) if (buf(1) == '-') { c = clower(buf(2)) if (c == 'f') { j = 3 pad = ctoi(buf, j) pad = min(pad, MAXPAD) pad = max(pad, MINPAD) } else if (c == 'p') { if (rawin != COOKED & rawout != COOKED) { j = 3 pagesz = ctoi(buf, j) if (pagesz <= 0) pagesz = NOPAGING } } else call badarg(buf) } else { call strcpy(buf, scrfil) defalt = NO } crlf(1) = CR crlf(2) = LF j = 3 call pchar(NULLCHAR, pad, crlf, j) crlf(j) = EOS call banner if (defalt == YES) call gtlock(lockid) # lock DELIVR out if (readmf(scrfil, NONOTIFY, LISTHEADERS, linara) == ERR) { call putlin(scrfil, ERROUT) call remark(" : cannot open. Use Read command") } call close(ERROUT) # save a unit, as error messages are # displayed on STDOUT if (defalt == YES) call rmlock(lockid) return end #-h- msgseq 2595 asc 13-jun-83 14:16:44 sventek (joseph sventek) integer function msgseq(linara) integer linara(MAXHEADERS), i, j, value, status integer matchs, length, dosequ, inbtst, matcht character getch, clower, gtrwln, type, gseqno character c, text(FILENAMESIZE), trmara(4) include cmsg include chdrs include crest string msgstr " (message sequence) " string allstr "all messages" string curstr "current message" string frmstr "from string: " string subst "subject string: " string textst "text string: " string delstr "deleted messages" string undstr "un" string seqerr " ? Invalid message sequence!" data trmara/CR, LF, ESC, EOS/ repeat { call Mptlin(msgstr) c = clower(getch(c, STDIN)) if (c == '?') j = dosequ(c) } until (c != '?') status = OK # assume success if (c == 'f' | c == 's' | c == 't') # search from | subject | text { switch (c) { case 'f': call Mptlin(frmstr) case 's': call Mptlin(subst) case 't': call Mptlin(textst) } j = 1 if (gtrwln(text, 1, STDIN, STDOUT, trmara) == ESC) status = ERR else if (text(1) != EOS) { for (i=1; i <= nmsgs; i=i+1) { if (c == 't') value = matcht(i, text, rest) else { if (c == 'f') { call gthlin(hfrom(i), rest) call canonf(rest) } else call gthlin(hsubj(i), rest) value = matchs(rest, text) } if (value == YES) { linara(j) = i j = j + 1 } } linara(j) = 0 } else status = ERR } else if (c == 'a') { call Mptlin(allstr) for (i=1; i <= nmsgs; i=i+1) linara(i) = i linara(i) = 0 } else if (c == 'n') { call Mptlin("new messages") j = 1 for (i = 1; i <= nmsgs; i = i + 1) if (inbtst(hstate(i), N_MASK) == N_MASK) { linara(j) = i j = j + 1 } linara(j) = 0 } else if (c == 'd' | c == 'u') { if (c == 'd') value = D_MASK else { value = 0 call Mptlin(undstr) } call Mptlin(delstr) j = 1 for (i=1; i <= nmsgs; i=i+1) if (inbtst(hstate(i), D_MASK) == value) { linara(j) = i j = j + 1 } linara(j) = 0 } else if (c == CR | c == LF | c == 'c') { call Mptlin(curstr) linara(1) = curmsg linara(2) = 0 } else if (type(c) == DIGIT) status = gseqno(c, linara) else status = ERR if (status == ERR) call Mptlin(seqerr) return(status) end #-h- onemsg 267 asc 19-oct-83 09:42:36 sventek (joseph sventek) subroutine onemsg(n) integer n, linara(2), junk integer putmf include cmsg include cfiltr string msghdr "@n(message #, * characters)" data linara(2) /0/ linara(1) = n filter = YES junk = putmf(msghdr, linara, STDOUT, pagesz) filter = NO return end #-h- pchar 155 asc 29-jun-82 08:26:55 j (sventek j) subroutine pchar(c, n, lin, j) character c, lin(ARB) integer n, i, j for (i=1; i <= n; i=i+1) { lin(j) = c j = j + 1 } return end #-h- ptmlin 1160 asc 22-nov-82 08:23:27 tools (lblh csam sventek) subroutine ptmlin(lin, int) character lin(ARB), buf(100), c filedes int integer i, j, l, len integer length, index include cmsg include ccrlf string okctrl "@r@l@f" if (int == STDOUT & rawout != COOKED) { len = length(crlf) j = 1 for (i=1; lin(i) != EOS; i=i+1) { c = lin(i) if (c == '@n') l = len else if (c < ' ') # have a control character if (index(okctrl, c) > 0) # valid l = 1 else l = 2 # will expand into ^ else l = 1 if ((j + l) >= 100) { call putlin(buf, int) buf(1) = EOS j = 1 } if (c == '@n') call stcopy(crlf, 1, buf, j) else { if (l == 2) { call chcopy('^', buf, j) c = c + '@@' } call chcopy(c, buf, j) } } if (j > 1) call putlin(buf, int) # call strcpy(lin, buf) # call sbst(buf, '@n', crlf) # call putlin(buf, int) } else call putlin(lin, int) return end #-h- puthdr 1161 asc 09-feb-83 13:15:12 sventek (joseph sventek) subroutine puthdr(n, int) integer n, int, m, itoc, length, i, ditoc integer fstate character temp(10), buf(100) include chdrs include cmsg include csize include crest if (n >= 1 & n <= nmsgs) { i = 1 m = STATE_W - fstate(hstate(n), temp) call stcopy(temp, 1, buf, i) call pchar(' ', m, buf, i) m = NUMB_W - itoc(n, temp, 10) call pchar(' ', m, buf, i) call stcopy(temp, 1, buf, i) call chcopy(' ', buf, i) size(1) = hsize(1, n) size(2) = hsize(2, n) m = SIZE_W - ditoc(size, temp, 10) call pchar(' ', m, buf, i) call stcopy(temp, 1, buf, i) call chcopy(' ', buf, i) call gthlin(hdate(n), rest) call canond(rest) rest(DATE_W) = EOS m = DATE_W - length(rest) call stcopy(rest, 1, buf, i) call pchar(' ', m, buf, i) call gthlin(hfrom(n), rest) call canonf(rest) rest(FROM_W) = EOS m = FROM_W - length(rest) call stcopy(rest, 1, buf, i) call pchar(' ', m, buf, i) call gthlin(hsubj(n), rest) rest(SUBJ_W) = EOS call stcopy(rest, 1, buf, i) call chcopy('@n', buf, i) buf(i) = EOS call ptmlin(buf, int) } return end #-h- putmf 1555 asc 19-oct-83 09:42:38 sventek (joseph sventek) integer function putmf(hdrstr, linara, int, page) character hdrstr(ARB) integer linara(MAXHEADERS), int, i, n, junk, page, ifmove integer itoc, length, gtcont, ditoc, equal, inbclr, inbtst, inbset, fstats, sdrcpt include msgscr include chdrs include csize include cfiltr include cmsg string constr "[type SPACE for next message]" ifmove = equal(hdrstr, hdrpat) for (i=1; i < MAXHEADERS & linara(i) != 0; i=i+1) { if (i > 1 & page > 0) if (gtcont(constr) == NO) break n = linara(i) if (ifmove == NO) # mark message as read { if (inbtst(hstate(n), N_MASK) != 0) ifmods = YES hstate(n) = inbclr(hstate(n), N_MASK) } junk = itoc(n, scrfil, 10) call strcpy(hdrstr, buf) call sbst(buf, MSGNOCHAR, scrfil) size(1) = hsize(1, n) size(2) = hsize(2, n) junk = ditoc(size, scrfil, 10) call sbst(buf, MSGSIZECHAR, scrfil) call ptmlin(buf, int) junk = length(buf) if( junk == 0 ) # dpm (15-Dec-81) call mputch( '@n', int) else if (buf(junk) != '@n') call mputch('@n', int) if (fstats(hstate(n), buf) > 0) # formatted status line call ptmlin(buf, int) # output it call putmsg(n, int, page) if (filter == YES & inbtst(hstate(n), arith(C_MASK,+,R_MASK)) == R_MASK) if (sdrcpt(n) == OK) # send receipt { hstate(n) = inbset(hstate(n), C_MASK) # mark as sent ifmods = YES } } if (i > 1) n = linara(i-1) else n = curmsg return(n) end #-h- putmsg 1224 asc 14-mar-83 15:20:40 sventek (joseph sventek) subroutine putmsg(n, int, page) integer n, int, i, m, j, page, expand, inhead, doit integer getlin, gtcont, isatty, hdrchk include chdrs include cmsg include msgscr include csize string null "" if (n >= 1 & n <= nmsgs) { expand = isatty(int) # only expand tabs for terminals call seek(haddr(n), unit) size(1) = hsize(1, n) size(2) = hsize(2, n) initdi(incs) j = 0 inhead = YES doit = YES while (!(size(1) <= 0 & size(2) <= 0)) { incs(2) = getlin(buf, unit) if (incs(2) == EOF) break if (buf(1) == '@n') inhead = NO if (page > 0 & j >= page) if (gtcont(null) == NO) break else j = 0 if (expand == YES) # expand any TABS call exptab(buf) if (inhead == YES) { if (buf(1) != ' ' & buf(1) != '@t') # not a continuation line doit = hdrchk(buf) # see if printable header # else # continuation lines inherit current value of doit } else doit = YES if (doit == YES) { call ptmlin(buf, int) j = j + 1 } subdi(incs, size) } } return end #-h- readmf 1138 asc 19-sep-83 12:33:40 sventek (joseph sventek) integer function readmf(tfile, ifnot, iflist, linara) character tfile(ARB), temp(4) integer ifnot, iflist, i, linara(MAXHEADERS), j, junk integer inbtst, itoc filedes fopen, fcreat, in include cmsg include chdrs string redstr "reading..." if (unit != ERR) call close(unit) nmsgs = 0 curmsg = 0 ifmods = NO if (fopen(tfile, READ, in) == ERR) { readmf = ERR file(1) = EOS return } if (fcreat(scrat, READWRITE, unit) != ERR) { call strcpy(tfile, file) if (ifnot == NOTIFY) call Mptlin(redstr) call gthptr(in) curmsg = min(0, nmsgs) if (iflist == LISTHEADERS) { j = 1 for (i=1; i <= nmsgs; i=i+1) if (inbtst(hstate(i), N_MASK) == N_MASK) { linara(j) = i j = j + 1 } linara(j) = 0 junk = itoc(nmsgs, temp, 4) call Mputc('@n') call Mptlin(temp) call Mptlin(" messages / ") junk = itoc(j-1, temp, 4) call Mptlin(temp) call Mptlin(" new") call headmf('@n', linara, STDOUT, pagesz) } } call close(in) readmf = unit return end #-h- savemf 1464 asc 25-jul-83 15:05:03 sventek (joseph sventek) integer function savemf(linara, comand) integer linara(MAXHEADERS), i, access, mmsgs, lockid integer mfsave, readmf, amove, inbset character comand, tmfile(FILENAMESIZE) include cmsg include chdrs include msgscr string mbox "mbox" string mymail "mymail" string temp "mymail.tmp" if (defalt == NO) { access = READWRITE call strcpy(file, tmfile) } else if (comand == 'e') # exit and update for default { call concat(home, mbox, tmfile) access = APPEND } else { access = READWRITE call concat(home, temp, tmfile) } if (mfsave(tmfile, access, linara, NOTIFY) == ERR) savemf = ERR else if (defalt == YES) { mmsgs = nmsgs # remember previous number of msgs call gtlock(lockid) # lock DELIVR out if (readmf(file, NONOTIFY, NOLISTHEADERS, linara) == ERR) savemf = ERR else { for (i=1; i <= mmsgs; i=i+1) hstate(i) = inbset(hstate(i), D_MASK) ifmods = YES if (comand == 'e') # exit and update default { savemf = mfsave(file, READWRITE, linara, NONOTIFY) defalt = NO call concat(home, mbox, file) } else { if (mfsave(tmfile, APPEND, linara, NONOTIFY) == ERR) savemf = ERR else savemf = amove(tmfile, file) } } call rmlock(lockid) # let DELIVR at it } else savemf = OK return end #-h- sbst 221 asc 01-jul-82 16:29:34 j (sventek j) ## sbst - substitute a string for a specified character subroutine sbst(buf, c, str) character buf(ARB), c, str(ARB) integer i for (i=1; buf(i) != EOS; i=i+1) if (buf(i) == c) call chrstr(buf, i, str) return end #-h- scnhdr 362 asc 09-feb-83 10:58:48 sventek (joseph sventek) integer function scnhdr(staddr, str, buf, fd) linepointer staddr character str(ARB), buf(MAXLINE) filedes fd integer stat integer getlin, match1 call seek(staddr, fd) # seek to top of header repeat { stat = getlin(buf, fd) if (stat == EOF | stat == 1) # EOF or end-of-header break if (match1(buf, str) == YES) return(YES) } return(NO) end #-h- sdrcpt 1796 asc 09-feb-83 16:15:21 sventek (joseph sventek) # sdrcpt - send return receipt to sender integer function sdrcpt(n) integer n integer status, i, junk integer scnhdr, spwnit, remove filedes fd filedes fcreat include chdrs include cmsg include crest include msgscr string str "@nSending receipt - please wait for prompt" string cmd1 "sndmsg '-sAutomatic receipt' -t" string cmd2 " '-@@" string cmd3 "' <" string sndr "THE-MAIL-SYSTEM" string rcm "rcm" string rct "rct" string msgids "Message-Id:" string s1 "This is an automatically generated acknowledgement of the receipt of" string s2 "your message. Excerpts from the message header follow:@n@n Date: " string s3 " Subject: " string twoblk " " call Mptlin(str) # tell user why were slow call scratf(rcm, scrfil) # file for body of message call scratf(rct, tfile) # file for to addresses status = ERR # assume error if (fcreat(scrfil, WRITE, fd) != ERR) # create body of message { call gthlin(hdate(n), buf) # get date of message call putlnl(s1, fd) call putlin(s2, fd) call putlnl(buf, fd) call gthlin(hsubj(n), buf) call putlin(s3, fd) call putlnl(buf, fd) if (scnhdr(haddr(n), msgids, buf, unit) == YES) { call putlin(twoblk, fd) call putlnl(buf, fd) } call close(fd) if (fcreat(tfile, WRITE, fd) != ERR) # create file with to address { call grplad(n, rest) # get reply address call putlnl(rest, fd) call close(fd) i = 1 call stcopy(cmd1, 1, buf, i) call stcopy(tfile, 1, buf, i) call strcpy(sndr, rest) call scrypt(rest) call stcopy(cmd2, 1, buf, i) call stcopy(rest, 1, buf, i) call stcopy(cmd3, 1, buf, i) call stcopy(scrfil, 1, buf, i) if (spwnit(buf) != ERR) status = OK junk = remove(tfile) } junk = remove(scrfil) } return (status) end #-h- spwnit 366 asc 16-jun-83 14:17:08 sventek (joseph sventek) integer function spwnit(buf) character buf(ARB), image(FILENAMESIZE), c, pid(PIDSIZE) integer i, junk integer loccom, spawn string suffix IMAGE_SUFFIX string path STD_PATH i = 1 call skipto(buf, i, ' ') c = buf(i) buf(i) = EOS junk = loccom(buf, path, suffix, image) call Mputc('@n') buf(i) = c spwnit = spawn(image, buf, pid, WAIT) return end #-h- matcht 481 asc 10-feb-83 08:34:38 sventek (joseph sventek) # matcht - see if body of message `n' contains the string `text' integer function matcht(n, text, buf) integer result integer getlin, match1, matchs include chdrs include cmsg call seek(htext(n), unit) # seek to start of message result = NO # assume no match while (getlin(buf, unit) != EOF) if (match1(buf, hdrpat) == YES) # end of message break else if (matchs(buf, text) == YES) # found matching string { result = YES break } return (result) end #-h- gtlock 378 asc 25-jul-83 13:50:29 sventek (joseph sventek) subroutine gtlock(lockid) integer lockid integer i integer index, crlock character user(MAX_TOK) call mailid(user) # get this user's name i = index(user, ' ') if (i > 0) user(i) = EOS call fold(user) while (crlock(user, lockid) == ERR) # repeat until we get it right { call Mptlin("Mail file locked by DELIVR - wait 5 seconds.@n") call sleep(5) } return end #-h- msgscr 237 asc 05-aug-83 17:15:44 sventek (joseph sventek) common / msgscr / buf(MAXLINE), scrfil(FILENAMESIZE), tfile(FILENAMESIZE) character buf # scratch buffer for io character scrfil # scratch array for file names character tfile # another scratch array used by doansw, doforw, doread #-h- msplit.r 1695 asc 05-aug-83 17:15:45 sventek (joseph sventek) #-h- defns 16 asc 24-nov-82 17:10:05 sventek (joseph sventek) include mailsym #-h- main 811 asc 16-jun-83 13:01:03 sventek (joseph sventek) DRIVER(msplit) character ch, cl, root(FILENAMESIZE), file(FILENAMESIZE) integer i, verbos, status integer getarg, equal, cpymsg string dfroot "tmsg" string minusv "-v" data ch/'a'/ data cl/'a'/ call query("usage: msplit 'z') { cl = 'a' ch = ch + 1 } } until (status == EOF) DRETURN end #-h- cpymsg 641 asc 25-mar-82 08:13:45 v1.1 (sw-tools v1.1) integer function cpymsg(n, file) integer n, out, i, status, junk integer create, getlin, equal, note linepointer temp character file(FILENAMESIZE), hdrpat(4), buf(MAXLINE) data hdrpat/1, 1, '@n', EOS/ out = create(file, WRITE) if (out == ERR) call cant(file) i = 0 repeat { junk = note(temp, STDIN) status = getlin(buf, STDIN) if (status == EOF) break if (equal(buf, hdrpat) == YES) { i = i + 1 if (i > n) { call seek(temp, STDIN) # backup one line status = n # n messages copied break } } call putlin(buf, out) } call close(out) cpymsg = status return end #-h- mstop.r 1641 asc 05-aug-83 17:15:47 sventek (joseph sventek) #-h- defns 113 asc 24-jul-82 08:32:14 j (sventek j) include mailsym define(MAX_MFLUSH,60) # give mflush 5 minutes define(MAX_DELIVR,120) # give delivr 10 minutes #-h- main 1385 asc 16-jun-83 13:01:54 sventek (joseph sventek) DRIVER(mstop) filedes fd filedes fcreat, fopen integer junk, status, i, count integer sleep, sndmlr, isaliv, index character user(USERSIZE), buf(MSG_SIZE) string pname "mstop?" string lockf MSTOP_LOCK string mflock MFLUSH_LOCK string termn8 TERMINATE_MESSAGE string passwd MAIL_PASSWORD string delivr "delivr" call query("usage: mstop [-p]") call valid8(passwd) call minit(pname) call mailid(user) i = index(user, ' ') if (i > 0) user(i) = EOS i = 1 call stcopy(termn8, 1, buf, i) call chcopy(GS, buf, i) call stcopy(user, 1, buf, i) if (fcreat(lockf, WRITE, fd) == ERR) call error("Cannot create lock file - ~msg/mstop.lck") call putch('@n', fd) call close(fd) for (count = 1; count <= MAX_MFLUSH; count = count + 1) { if (fopen(mflock, READ, fd) == ERR) break call close(fd) call remark("Mflush is active. Will wait 5 seconds and try again") junk = sleep(5) } if (count > MAX_MFLUSH) call remark("Mflush did not exit - ~msg may be in an inconsistent state") status = sndmlr(buf) if (status != EOF) call error("Error sending termination message to Mailer") for (count = 1; count <= MAX_DELIVR; count = count + 1) { if (isaliv(delivr) == NO) break call remark("Wait 5 seconds for Delivr to flush its queue") junk = sleep(5) } if (count >= MAX_DELIVR) call remark("Delivr did not exit - ~msg may be in an inconsistent state") DRETURN end #-h- mtrace.r 804 asc 05-aug-83 17:15:48 sventek (joseph sventek) #-h- main 727 asc 16-jun-83 13:02:25 sventek (joseph sventek) include mailsym DRIVER(mtrace) integer i integer sndmlr, index, getarg character user(USERSIZE), buf(MSG_SIZE), arg(10), level string trcmsg TRACE_MESSAGE string passwd MAIL_PASSWORD string pname "mtrace?" string succes "@rTrace level has been updated.@n" call query("usage: mtrace [-p] [level]") call valid8(passwd) # validate user level = '0' for (i=1; getarg(i, arg, 10) != EOF; i=i+1) if (IS_DIGIT(arg(1))) { level = arg(1) break } call minit(pname) call mailid(user) i = index(user, ' ') if (i > 0) user(i) = EOS i = 1 call stcopy(trcmsg, 1, buf, i) call chcopy(level, buf, i) call chcopy(GS, buf, i) call stcopy(user, 1, buf, i) if (sndmlr(buf) == OK) call putlin(succes, ERROUT) DRETURN end #-h- nalias.r 641 asc 05-aug-83 17:15:50 sventek (joseph sventek) #-h- main 564 asc 16-jun-83 13:02:58 sventek (joseph sventek) include mailsym DRIVER(nalias) integer i integer sndmlr, index character user(USERSIZE), buf(MSG_SIZE) string reload RELOAD_MESSAGE string passwd MAIL_PASSWORD string pname "nalias?" string succes "@rMailer has reloaded address and malias files.@n" call query("usage: nalias [-p]") call valid8(passwd) # validate user call minit(pname) call mailid(user) i = index(user, ' ') if (i > 0) user(i) = EOS i = 1 call stcopy(reload, 1, buf, i) call chcopy(GS, buf, i) call stcopy(user, 1, buf, i) if (sndmlr(buf) == OK) call putlin(succes, ERROUT) DRETURN end #-h- net.m 14418 asc 10-aug-83 12:11:21 sventek (joseph sventek) #-h- netabt.mac 708 asc 16-aug-82 23:40:30 sventek (joseph sventek) .title netabt ;+ ; status = netabt(desc, out, len) ; ; return(OK/ERR) ; ; aborts the current logical link and returns lun to free pool ; ap=%5 desc=2 out=4 len=6 ; .mcall abt$s,stse$s ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netabt:: mov @desc(ap),r0 ; get lun ble 10$ ; if <= 0, invalid lun clr r1 ; assume no message mov @len(ap),r2 ; length of message beq 1$ ; no message mov out(ap),r1 ; address of message 1$: abt$s r0,r$ntef,#r$ntsb,, bcs 10$ ; directive error stse$s r$ntef ; wait for completion tstb r$ntsb ; successful? ble 10$ ; NO call r$plun ; return lun to free pool mov #ok,r0 ; return(OK) return 10$: mov #err,r0 ; return(ERR) return .end #-h- netacc.mac 787 asc 16-aug-82 23:40:31 sventek (joseph sventek) .title netacc - connect accept ;+ ; status = netacc(buf, out, len, desc) ; ; return(lun/ERR) ;- .mcall acc$s,stse$s,alun$s ; ap=%5 buf=2 out=4 len=6 desc=10 ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netacc:: call r$glun ; fetch a lun for logical link bcs 10$ ; none available alun$s r0,#"NS,#0 ; assign lun to NS: bcs 5$ ; assign failed clr r1 ; assume no message mov @len(ap),r2 ; length of message beq 1$ ; no message mov out(ap),r1 ; address of message 1$: acc$s r0,r$ntef,#r$ntsb,, bcs 5$ ; directive error stse$s r$ntef ; wait for completion tstb r$ntsb ; successful? bgt 20$ ; YES 5$: call r$plun ; return lun to free pool 10$: mov #err,r0 ; return(ERR) 20$: mov r0,@desc(ap) ; return lun as descriptor return .end #-h- netbcb.mac 1765 asc 16-aug-82 23:40:32 sventek (joseph sventek) .title netbcb - build connect block ;+ ; call netbcb(buf, node, obj, fmt, task, name, pass, acnt) ; ; builds a connect block from the information passed in the args ; ; buf will contain the resulting connect block and ; node, task, name, pass and acnt are EOS terminated strings ;- .mcall crbdf$ crbdf$ ; define connect block offsets ; ; local macros ; .macro cpystr src,dst mov r4,r2 add #n.'dst',r2 mov 'src'(ap),r1 call scopy .endm cpystr ; ap=%5 buf=2 node=4 obj=6 fmt=10 task=12 name=14 pass=16 acnt=20 ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netbcb:: mov buf(ap),r4 ; address of connect block cpystr node,rnd ; copy node string 10$: cmp r0,#6 ; done padding with blanks? bge 20$ ; YES movb #' ,(r2)+ ; copy blank inc r0 ; update counter br 10$ ; go again 20$: movb @obj(ap),n.rot(r4) ; copy object type movb @fmt(ap),n.rfm(r4) ; copy format identifier beq 30$ ; if == 0, no need for task name cpystr task,rde ; copy task string mov r0,n.rdec(r4) ; " " " length 30$: cpystr name,rid ; copy name string mov r0,n.ridc(r4) ; " " " length cpystr pass,rps ; copy password string mov r0,n.rpsc(r4) ; " " " length cpystr acnt,rac ; copy account string mov r0,n.racc(r4) ; " " " length return ; ; subroutine scopy ; ; inputs: ; r1 source string ; r2 destination address ; ; outputs: ; the 0-byte string in r1 is copied to r2, without the ; 0-byte ; r0 number of bytes copied ; r1 mangled ; r2 address of first free position in output string ; r3 mangled ; scopy: clr r0 ; initialize count 1$: movb (r1)+,r3 ; get next character beq 2$ ; if == 0, done movb r3,(r2)+ ; copy into destination inc r0 ; update counter br 1$ 2$: return .end #-h- netcls.mac 647 asc 18-aug-82 09:56:31 sventek (joseph sventek) .title netcls ;+ ; status = netcls(status) ; ; return(OK/ERR) ; ; closes down the task's network activity ; the lun and efns allocated in netopn are retained for further use ; ap=%5 status=2 ; .mcall cls$s,stse$s ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netcls:: tst r$ntop ; is task currently network active? beq 10$ ; NO cls$s r$ntln,r$ntef,#r$ntsb bcs 10$ ; directive error stse$s r$ntef ; wait for completion tstb r$ntsb ; successful? ble 10$ ; NO clr r$ntop ; no longer network active mov #ok,r0 ; return(OK) br 20$ 10$: mov #err,r0 ; return(ERR) 20$: mov r0,@status(ap) ; return in status return .end #-h- netcon.mac 1918 asc 10-aug-83 12:09:52 sventek (joseph sventek) .title netcon - request logical link connection ;+ ; status = netcon(buf, out, outl, in, inl, xtra, desc) ; ; requests a logical link connection, returning the lun if successful ; as status and desc. xtra will have the number of bytes sent by ; the responding task which are stored in in. ; ; return(ERR) if unsuccessful ;- .mcall alun$s,con$s,stse$s,crbdf$,nssym$ crbdf$ nssym$ ; ap=%5 buf=2 out=4 outl=6 in=10 inl=12 xtra=14 desc=16 tries=2 ; .psect $r.rwd,con,rw,rel,lcl,d ntries: .blkw 1 ; number of remaining tries for ; timed-out connect requests .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netcon:: mov #tries,ntries ; initial number of tries call r$glun ; get a lun for logical link bcs 10$ ; none available alun$s r0,#"NS,#0 ; assign lun to NS: bcs 5$ ; c set => assign error clr r1 ; assume no message mov @outl(ap),r2 ; get message length beq 1$ ; no message mov out(ap),r1 ; message address 1$: clr r3 ; assume no buffer mov @inl(ap),r4 ; get buffer size beq 2$ ; no buffer mov in(ap),r3 ; buffer address 2$: con$s r0,r$ntef,#r$ntsb,, bcs 5$ ; directive error stse$s r$ntef ; wait for completion cmpb #is.suc,r$ntsb ; successful? bne 5$ ; NO ; tstb r$ntsb ; successful? ; ble 5$ ; NO mov r$ntsb+2,@xtra(ap) ; size of message sent by responder mov r0,@desc(ap) ; return lun return 5$: cmpb #ie.nrj,r$ntsb ; network reject? bne 9$ ; NO, just return error cmpb #ne$mlb,r$ntsb+2 ; object too busy? beq 6$ ; YES, try again cmpb #ne$abo,r$ntsb+2 ; no response from object? bne 9$ ; NO, just return error 6$: dec ntries ; decrement number of tries bgt 2$ ; if positive, try again 9$: mov $dsw,-(sp) ; return dsw in low byte movb r$ntsb,1(sp) ; io status in high byte mov (sp)+,@xtra(ap) ; return to user call r$plun ; return lun to free pool 10$: mov #err,r0 ; return(ERR) return .end #-h- netdat.mac 367 asc 18-aug-82 09:56:33 sventek (joseph sventek) .title netdat - tools network data area ; ; .psect $r.rwd,con,rw,rel,lcl,d r$ntef:: .word 0 ; holds network event flag r$ntto:: .word 0 ; holds timeout event flag r$ntmk:: .word 0 ; holds wtlo mask r$ntln:: .word 0 ; lun for general network delivery r$ntop:: .word 0 ; non-zero if task network active r$ntsb:: .word 0,0 ; i/o status block for net calls .end #-h- netdsc.mac 713 asc 16-aug-82 23:40:37 sventek (joseph sventek) .title netdsc ;+ ; status = netdsc(desc, out, len) ; ; return(OK/ERR) ; ; disconnects the current logical link and returns lun to free pool ; ap=%5 desc=2 out=4 len=6 ; .mcall dsc$s,stse$s ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netdsc:: mov @desc(ap),r0 ; get lun ble 10$ ; if <= 0, invalid lun clr r1 ; assume no message mov @len(ap),r2 ; length of message beq 1$ ; no message mov out(ap),r1 ; address of message 1$: dsc$s r0,r$ntef,#r$ntsb,, bcs 10$ ; directive error stse$s r$ntef ; wait for completion tstb r$ntsb ; successful? ble 10$ ; NO call r$plun ; return lun to free pool mov #ok,r0 ; return(OK) return 10$: mov #err,r0 ; return(ERR) return .end #-h- netgln.mac 1065 asc 18-aug-82 09:56:34 sventek (joseph sventek) .title netgln - get local node information ;+ ; status = netgln(node, segsiz) ; ; return(OK/ERR) ; ; the node name is returned as an EOS-terminated string in node ; the NSP segment size is returned as an integer in segsiz ;- .mcall gln$s,stse$s ; ap=%5 node=2 segsiz=4 ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netgln:: sub #8.,sp ; buffer for GLN mov sp,r0 ; save address tst r$ntop ; task network active? beq 10$ ; NO gln$s r$ntln,r$ntef,#r$ntsb,, bcs 10$ ; directive error stse$s r$ntef ; wait for completion tstb r$ntsb ; successful? ble 10$ ; NO mov r0,r1 ; source address mov node(ap),r2 ; destination address mov #6,r3 ; number of chars to move 1$: movb (r1)+,(r2)+ ; copy character sob r3,1$ ; go again 2$: cmpb #' ,-1(r2) ; last character a blank? bne 3$ ; NO dec r2 ; trim blank br 2$ ; try again 3$: clrb (r2) ; EOS terminate mov 6(r0),@segsiz(ap) ; copy segment size mov #ok,r0 ; return(OK) br 20$ 10$: mov #err,r0 ; return(ERR) 20$: add #8.,sp ; clean up stack return .end #-h- netgnd.mac 669 asc 18-aug-82 09:56:35 sventek (joseph sventek) .title netgnd - get network data ;+ ; status = netgnd(buf, type, xtra) ; ; return(size of message/ERR) ;- .mcall gnd$s,stse$s ; ap=%5 buf=2 type=4 xtra=6 ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netgnd:: tst r$ntop ; task network active? beq 10$ ; NO gnd$s r$ntln,r$ntef,#r$ntsb,, bcs 10$ ; directive error stse$s r$ntef ; wait for completion tstb r$ntsb ; successful? ble 10$ ; NO movb r$ntsb+1,r0 ; get message type mov r0,@type(ap) ; return to user movb r$ntsb+3,r0 ; get extra information mov r0,@xtra(ap) ; return to user movb r$ntsb+2,r0 ; size of message return 10$: mov #err,r0 ; return(ERR) return .end #-h- netopn.mac 1522 asc 18-aug-82 09:56:36 sventek (joseph sventek) .title netopn - declare network task ;+ ; status = netopn(status) ; ; return(OK/ERR) ; ; declares calling task as an active network task and establishes ; network lun and efn ; .mcall alun$s,opn$s,stse$s ; ap=%5 status=2 ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netopn:: tst r$ntef ; need efn for network IO? bne 1$ ; NO call r$gefn ; get a free event flag bcs 10$ ; c set => none available mov r0,r$ntef ; store in global location 1$: tst r$ntto ; need event flag for timeouts? bne 2$ ; NO call r$gefn ; get event flag for timeouts bcs 10$ ; c set => none available mov r0,r$ntto ; store in global location 2$: tst r$ntmk ; generate WTLO mask? bne 3$ ; NO mov #-1,r$ntmk ; build mask for wtlo mov #16,r1 ; ... mov #r$ntmk,r2 ; ... mov #1,r3 ; ... mov r$ntto,r0 ; ... call frebit ; ... mov r$ntef,r0 ; ... call frebit ; ... com r$ntmk ; ... 3$: mov r$ntln,r0 ; fetch general delivery lun bne 4$ ; do not need to get lun call r$glun ; get a free lun bcs 10$ ; none available mov r0,r$ntln ; store in global location 4$: alun$s r0,#"NS,#0 ; assign lun to network bcs 10$ ; c set => error opn$s r0,r$ntef,#r$ntsb,,<#5,#5>; declare network task bcs 10$ ; directive error stse$s r$ntef ; wait for completion tstb r$ntsb ; successful? ble 10$ ; NO mov #1,r$ntop ; non-zero => network active task mov #ok,r0 ; return(OK) br 20$ 10$: mov #err,r0 ; return(ERR) 20$: mov r0,@status(ap) ; return in variable also return .end #-h- netrec.mac 1122 asc 05-aug-83 10:24:57 sventek (joseph sventek) .title netrec - receive message on logical link ;+ ; status = netrec(desc, buf, len) ; ; if the network receive does not complete in 60 seconds, an error ; indication is returned to the requestor ; ; alternate entry - netrcv same, but has a 30 MINUTE timeout ; ; return(size of message/EOF) ;- .mcall rec$s .mcall mrkt$s,wtlo$s,setf$s,qiow$s,cmkt$s ; ap=%5 desc=2 buf=4 len=6 ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netrec:: mov #60.,r0 ; 60 second timeout mov #2,r1 ; seconds br 1$ ; branch to common code netrcv:: mov #30.,r0 ; 30 minute timeout mov #3,r1 ; minutes 1$: rec$s @desc(ap),r$ntef,#r$ntsb,, bcs 10$ ; directive error mrkt$s r$ntto,r0,r1 ; start timer wtlo$s 0,r$ntmk ; wait for completion | timeout setf$s r$ntef ; did the I/O complete? cmp @#$dsw,#is.set ; ... beq 5$ ; YES, cancel mark time qiow$s #io.kil,@desc(ap),r$ntto; NO, kill the network I/O br 10$ 5$: cmkt$s r$ntto,, ; cancel the mark time tstb r$ntsb ; successful? ble 10$ ; NO mov r$ntsb+2,r0 ; return(number of bytes) return 10$: mov #eof,r0 ; return(EOF) return .end #-h- netrej.mac 576 asc 16-aug-82 23:40:42 sventek (joseph sventek) .title netrej - reject connect request ;+ ; status = netrej(buf, out, len) ; ; return(OK/ERR) ;- .mcall rej$s,stse$s ; ap=%5 buf=2 out=4 len=6 ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netrej:: clr r1 ; assume no message mov @len(ap),r2 ; length of message beq 1$ ; no message mov out(ap),r1 ; address of message 1$: rej$s r$ntln,r$ntef,#r$ntsb,, bcs 10$ ; directive error stse$s r$ntef ; wait for completion tstb r$ntsb ; successful? ble 10$ ; NO mov #ok,r0 ; return(OK) return 10$: mov #err,r0 ; return(ERR) return .end #-h- netsnd.mac 1015 asc 05-aug-83 10:24:59 sventek (joseph sventek) .title netsnd - send message on logical link ;+ ; status = netsnd(desc, buf, len) ; ; return(size of message/ERR) ; ; Alternate entry netsen - 30 minute time limit instead of 60 seconds ;- .mcall snd$s .mcall mrkt$s,wtlo$s,setf$s,qiow$s,cmkt$s ; ap=%5 desc=2 buf=4 len=6 ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netsnd:: mov #60.,r0 ; 60 second time limit mov #2,r1 ; seconds br 1$ ; branch to common code netsen:: mov #30.,r0 ; 30 minute time limit mov #3,r1 ; minutes 1$: snd$s @desc(ap),r$ntef,#r$ntsb,, bcs 10$ ; directive error mrkt$s r$ntto,r0,r1 ; start timer wtlo$s 0,r$ntmk ; wait for completion | timeout setf$s r$ntef ; did the I/O complete? cmp @#$dsw,#is.set ; ... beq 5$ ; YES, cancel mark time qiow$s #io.kil,@desc(ap),r$ntto; NO, kill network I/O br 10$ 5$: cmkt$s r$ntto,, ; cancel mark time tstb r$ntsb ; successful? ble 10$ ; NO mov r$ntsb+2,r0 ; return(number of bytes) return 10$: mov #err,r0 ; return(ERR) return .end #-h- netxmi.mac 466 asc 16-aug-82 23:40:44 sventek (joseph sventek) .title netxmi - send interrupt message on logical link ;+ ; status = netxmi(desc, buf, len) ; ; return(OK/ERR) ;- .mcall xmi$s,stse$s ; ap=%5 desc=2 buf=4 len=6 ; .psect $r.roi,con,ro,rel,lcl,i .enabl lsb netxmi:: xmi$s @desc(ap),r$ntef,#r$ntsb,, bcs 10$ ; directive error stse$s r$ntef ; wait for completion tstb r$ntsb ; successful? ble 10$ ; NO mov #ok,r0 ; return(OK) return 10$: mov #err,r0 ; return(ERR) return .end #-h- net.r 1126 asc 05-aug-83 17:15:59 sventek (joseph sventek) #-h- dspcnb 1053 asc 30-mar-82 13:55:18 v1.1 (sw-tools v1.1) subroutine dspcnb(b, int) character b(72), x filedes int integer i, temp equivalence (temp, x) string node "nodename: " string format "format: " string object "object: " string task "taskname: " string name "username: " string pass "password: " string acnt "account: " string term "|@n" call putlin(node, int) for (i=1; i <= 6; i=i+1) call putch(b(i), int) call putlin(term, int) call putlin(format, int) temp = 0 x = b(7) call putint(temp, 1, int) call putlin(term, int) call putlin(object, int) x = b(8) call putint(temp, 1, int) call putlin(term, int) temp = 11 + b(9) call putlin(task, int) for (i=11; i < temp; i=i+1) call putch(b(i), int) call putlin(term, int) temp = 29 + b(27) call putlin(name, int) for (i=29; i < temp; i=i+1) call putch(b(i), int) call putlin(term, int) temp = 47 + b(45) call putlin(pass, int) for (i=47; i < temp; i=i+1) call putch(b(i), int) call putlin(term, int) temp = 57 + b(55) call putlin(acnt, int) for (i=57; i < temp; i=i+1) call putch(b(i), int) call putlin(term, int) return end #-h- netasm.sh 236 asc 05-aug-83 17:16:00 sventek (joseph sventek) lbr n.mlb/cr:10.::16.:MAC ar xv netlib.mar | ch "%" "lbr n.mlb/in=" | sh -v ar t netlib.mar | rm pip n.mlb/nv=lb:[1,1]netlib.mlb ar xv net.m | ch .mac | ch "%?*$" "mac &=n/ml,&.mac; lbr msg/rp=&" | sh -v ar t net.m | rm; rm n.mlb n.mlb #-h- netdlv.r 961 asc 05-aug-83 17:16:02 sventek (joseph sventek) #-h- main 884 asc 16-jun-83 13:03:44 sventek (joseph sventek) include mailsym DRIVER(netdlv) integer i, value, junk integer getarg, equal, index, itoc, sndmsg character user(USERSIZE), buf(MSG_SIZE), arg(10) string netmsg CHGNET_MESSAGE string passwd MAIL_PASSWORD string pname "netdlv?" string on "on" string delivr "delivr" string usestr "usage: netdlv [-p] {on|off}" call query(usestr) call valid8(passwd) # validate user arg(1) = EOS for (i=1; getarg(i, arg, 10) != EOF; i=i+1) if (arg(1) != '-') { call fold(arg) value = equal(arg, on) break } if (arg(1) == EOS) call error(usestr) call minit(pname) call mailid(user) i = index(user, ' ') if (i > 0) user(i) = EOS i = 1 call stcopy(netmsg, 1, buf, i) junk = itoc(value, arg, 10) call chcopy(arg(1), buf, i) call chcopy(GS, buf, i) call stcopy(user, 1, buf, i) if (sndmsg(delivr, buf) == ERR) call remark("Error resetting network delivery") DRETURN end #-h- netlib.mar 1704 asc 05-aug-83 17:16:03 sventek (joseph sventek) #-H- ABT.MDF 56 ASC 11-JUL-82 10:33:53 J (SVENTEK J) .MACRO ABT$S LUN,EFN,IOSB,AST,PRMLST SEC .ENDM ABT$S #-H- ACC.MDF 56 ASC 11-JUL-82 10:33:54 J (SVENTEK J) .MACRO ACC$S LUN,EFN,IOSB,AST,PRMLST SEC .ENDM ACC$S #-H- CLS.MDF 49 ASC 11-JUL-82 10:33:55 J (SVENTEK J) .MACRO CLS$S LUN,EFN,IOSB,AST SEC .ENDM CLS$S #-H- CON.MDF 56 ASC 11-JUL-82 10:33:56 J (SVENTEK J) .MACRO CON$S LUN,EFN,IOSB,AST,PRMLST SEC .ENDM CON$S #-H- CRBDF.MDF 176 ASC 11-JUL-82 10:33:57 J (SVENTEK J) .MACRO CRBDF$ N.RND=0 N.RFM=6 N.ROT=7 N.RDEC=10 N.RDE=12 N.RGP=10 N.RUS=12 N.RNMC=14 N.RNM=16 N.RIDC=32 N.RID=34 N.RPSC=54 N.RPS=56 N.RACC=66 N.RAC=70 N.RQL=110 .ENDM CRBDF$ #-H- DSC.MDF 56 ASC 11-JUL-82 10:33:58 J (SVENTEK J) .MACRO DSC$S LUN,EFN,IOSB,AST,PRMLST SEC .ENDM DSC$S #-H- GLN.MDF 56 ASC 11-JUL-82 10:33:58 J (SVENTEK J) .MACRO GLN$S LUN,EFN,IOSB,AST,PRMLST SEC .ENDM GLN$S #-H- GND.MDF 61 ASC 11-JUL-82 10:33:59 J (SVENTEK J) .MACRO GND$S LUN,EFN,IOSB,AST,PRMLST,FLAG SEC .ENDM GND$S #-H- OPN.MDF 56 ASC 11-JUL-82 10:34:00 J (SVENTEK J) .MACRO OPN$S LUN,EFN,IOSB,AST,PRMLST SEC .ENDM OPN$S #-H- REC.MDF 56 ASC 11-JUL-82 10:34:01 J (SVENTEK J) .MACRO REC$S LUN,EFN,IOSB,AST,PRMLST SEC .ENDM REC$S #-H- REJ.MDF 56 ASC 11-JUL-82 10:34:02 J (SVENTEK J) .MACRO REJ$S LUN,EFN,IOSB,AST,PRMLST SEC .ENDM REJ$S #-H- SND.MDF 56 ASC 11-JUL-82 10:34:02 J (SVENTEK J) .MACRO SND$S LUN,EFN,IOSB,AST,PRMLST SEC .ENDM SND$S #-H- XMI.MDF 56 ASC 11-JUL-82 10:34:03 J (SVENTEK J) .MACRO XMI$S LUN,EFN,IOSB,AST,PRMLST SEC .ENDM XMI$S #-h- netlist.src 284 asc 05-aug-83 17:16:04 sventek (joseph sventek) # # List of supported networks # # If you wish to support your own networks, you must follow the directions # given in the System Manager's Guide for the Software Tools Mail System # define(p_d,dmtptx) # Decnet is supported by default # VMS define(p_v,vmtptx) # Gateway to VMS Liam #-h- netsym 115 asc 05-aug-83 17:16:05 sventek (joseph sventek) define(CON_REQ,1) define(INT_MSG,2) define(USR_DSC,3) define(USR_ABT,4) define(NET_ABT,5) define(CON_BLK_SIZE,120) #-h- notify.r 3108 asc 05-aug-83 17:16:07 sventek (joseph sventek) #-h- defns 39 asc 01-jul-82 07:57:45 j (sventek j) include mailsym define(Mem_size,2000) #-h- main 1047 asc 16-jun-83 13:45:41 sventek (joseph sventek) DRIVER(notify) character buf(MAXLINE), user(MAX_TOK), defn(MAXLINE), temp(MAX_TOK) integer i, junk, uic, j integer getlin, length, getwrd, tblook, index filedes in, fopen DS_DECL(Mem, Mem_size) string adrfil "~msg/address" string null "" call tbinit(Mem_size) while (getlin(buf, STDIN) != EOF) { call fold(buf) i = length(buf) buf(i) = EOS if (buf(1) == '"') { call scopy(buf, 2, buf, 1) i = index(buf, '"') buf(i) = EOS } call tbinst(buf, null) } if (getarg(1, temp, MAX_TOK) == EOF) call strcpy(null, user) else { j = 1 call chcopy('<', user, j) call stcopy(temp, 1, user, j) call chcopy('>', user, j) call canonf(user) } call notint(user) if (fopen(adrfil, READ, in) == ERR) call error("Cannot open address file") while (getlin(buf, in) != EOF) { i = 1 junk = getwrd(buf, i, user) if (tblook(user, defn) == YES) { junk = getwrd(buf, i, defn) junk = getwrd(buf, i, defn) call makuic(defn, uic) call pack(uic) } } call notfin call close(in) DRETURN end #-h- makuic 401 asc 01-jul-82 07:57:48 j (sventek j) subroutine makuic(buf, uic) character buf(ARB) integer uic integer i, grp, mem, tuic integer type logical*1 grpb, memb, tuicb(2) equivalence (grp,grpb), (mem, memb), (tuic, tuicb(1)) grp = 0 for (i=2; type(buf(i)) == DIGIT; i=i+1) grp = 8 * grp + buf(i) - '0' mem = 0 for (i=i+1; type(buf(i)) == DIGIT; i=i+1) mem = 8 * mem + buf(i) - '0' tuicb(1) = memb tuicb(2) = grpb uic = tuic return end #-h- notfin 391 asc 01-jul-82 07:57:50 j (sventek j) subroutine notfin integer n, junk integer writef, sdat real ttynot include cnotfy data ttynot/6RTTYNOT/ lstpos = lstpos + 1 uic(lstpos) = 0 # terminate list with 0 n = 2 * lstpos # number of bytes in record junk = writef(uic, n, ofd) # write to scratch file call close(ofd) junk = sdat(ttynot, file) # send name of file to TTYNOT call reques(ttynot) # request it to run return end #-h- notint 711 asc 16-jun-83 13:45:43 sventek (joseph sventek) subroutine notint(user) character user(ARB), temp(256) integer n, junk integer writef filedes fcreat include cnotfy string head "@r@l@l@7@7Software Tools mail has arrived" string tail "@r@l" string from " from `" string seed "mnt" lstpos = 0 call scratf(seed, file) # name of file to communicate info to TTYNOT if (fcreat(file, WRITE, ofd) == ERR) # file creation failed call error("Error creating scratch file with info for TTYNOT") n = 1 call stcopy(head, 1, temp, n) if (user(1) != EOS) { call stcopy(from, 1, temp, n) call stcopy(user, 1, temp, n) call chcopy('@'', temp, n) } call stcopy(tail, 1, temp, n) n = n - 1 junk = writef(temp, n, ofd) # write the message to the file return end #-h- pack 101 asc 01-jul-82 07:57:50 j (sventek j) subroutine pack(val) integer val include cnotfy lstpos = lstpos + 1 uic(lstpos) = val return end #-h- postmn.r 2295 asc 05-aug-83 17:16:09 sventek (joseph sventek) #-h- defns 207 asc 30-mar-82 13:55:46 v1.1 (sw-tools v1.1) define(NUM_WIDTH,3) # width of message number field define(DAT_WIDTH,13) # width of date field define(FRM_WIDTH,25) # width of from field define(RIGHT_MARGIN,80) # number of columns on page include mailsym #-h- main 708 asc 19-oct-82 07:41:06 sventek (joseph sventek) DRIVER(postmn) character file(FILENAMESIZE), arg(FILENAMESIZE) integer headrs integer msize, getarg, match1 string mymail "mymail" string messag "You have Software Tools mail@n" string minush "-h" call query("usage: postmn [-h [file]]") headrs = NO call homdir(file, LOCAL) call concat(file, mymail, file) if (getarg(1, arg, FILENAMESIZE) != EOF) { if (match1(arg, minush) == YES) { headrs = YES if (getarg(2, arg, FILENAMESIZE) != EOF) call strcpy(arg, file) } else call badarg(arg) } if (msize(file) > 0) if (headrs == YES) call dohead(file, STDOUT) else call putlin(messag, STDOUT) return end #-h- dohead 797 asc 14-mar-83 23:08:36 sventek (joseph sventek) subroutine dohead(file, out) character file(FILENAMESIZE), buf(MAXLINE), from(MAXLINE), date(MAXLINE), subj(MAXLINE) integer nmsg, i integer nxthdr, getlin, match1, index filedes out, fd filedes fopen if (fopen(file, READ, fd) != ERR) { for (nmsg = 1; nxthdr(buf, fd) != EOF; nmsg = nmsg + 1) { call scnmsg(fd, from, date, subj, buf, YES) call putint(nmsg, NUM_WIDTH, out) call putch(' ', out) call canond(date) date(DAT_WIDTH) = EOS # truncate, if necessary call putstr(date, -DAT_WIDTH, out) call canonf(from) from(FRM_WIDTH) = EOS call putstr(from, -FRM_WIDTH, out) i = RIGHT_MARGIN - FRM_WIDTH - DAT_WIDTH - NUM_WIDTH - 1 subj(i) = EOS # truncate if necessary call putlnl(subj, out) } call close(fd) } return end #-h- msize 279 asc 22-oct-82 16:36:20 sventek (joseph sventek) integer function msize(file) character file(FILENAMESIZE), c character getch integer n filedes int filedes fopen if (fopen(file, READ, int) == ERR) return(ERR) n = 0 while (getch(c, int) != EOF) if (c != '@n') { n = 1 break } call close(int) return(n) end #-h- resolve.sh 49 asc 05-aug-83 17:16:11 sventek (joseph sventek) find -i <~msg/address $1 $2 $3 $4 $5 $6 $7 $8 $9 #-h- rmtxeq.r 3859 asc 05-aug-83 17:16:12 sventek (joseph sventek) #-h- defns 16 asc 18-apr-82 07:10:31 v1.1 (sw-tools v1.1) include mailsym #-h- main 2758 asc 16-jun-83 13:05:43 sventek (joseph sventek) DRIVER(rmtxeq) integer found, i, n, junk integer getlin, match1, length, popen, pclose, sndmlr, getwrd, valid8, remove filedes in, out, fcreat, open character to(MAX_TOK), date(MAX_TOK), bf(MAXLINE), outfil(FILENAMESIZE), rmtfil(FILENAMESIZE), host(HOST_SIZE) string datest "Date: " string fromst "From: " string retpth "Return-path:" string oseed "out" string rseed "rmt" string ats " @@ " string defalt "default" string mailfr MAIL_FROM_STR string rcptto RCPT_TO_STR string datast DATA_STR string rmtxeq "Rmtxeq" string inrepl "In-Reply-To: Your message of " string subjst "Subject: " string tost "To: " string pname "rmtxeq" string errmsg "Invalid command requested by " found = NO to(1) = EOS date(1) = EOS while (getlin(bf, STDIN) != EOF) if (bf(1) == '@n') break else if (match1(bf, datest) == YES) call fetrst(bf, date) else if (found == NO) { if (match1(bf, retpth) == YES) { call fetrst(bf, to) found = YES } } if (to(1) == EOS) call error("No From: string in message") if (getlin(bf, STDIN) != EOF) { i = 1 junk = getwrd(bf, i, outfil) if (valid8(outfil, to) == NO) { call putlin(errmsg, ERROUT) call putlnl(to, ERROUT) call error(bf) } call scratf(oseed, outfil) i = length(bf) n = i call chcopy(' ', bf, i) call chcopy('>', bf, i) call stcopy(outfil, 1, bf, i) if (popen(bf, WRITE, out) != ERR) { call fcopy(STDIN, out) if (pclose(out) != ERR) { call scratf(rseed, rmtfil) if (fcreat(rmtfil, WRITE, out) != ERR) { call angbrk(mailfr, rmtxeq, out) call putlin(rcptto, out) call putlnl(to, out) call putlnl(datast, out) call putlin(datest, out) call ptdate(out) call putlin(fromst, out) call putlin(rmtxeq, out) call putlin(ats, out) call gthost(defalt, host) call scopy(host, 2, host, 1) # overwrite '@@' call putlnl(host, out) call putlin(inrepl, out) call putlnl(date, out) call putlin(subjst, out) bf(n) = EOS call putlnl(bf, out) call putlin(tost, out) call putlnl(to, out) call putch('@n', out) in = open(outfil, READ) call fcopy(in, out) call close(in) call close(out) call minit(pname) if (sndmlr(rmtfil) == ERR) call remark("Error sending mail from rmtxeq") } else call remark("Error creating msg to return to user") } else call remark("Error closing pipe") } else call remark("Error creating pipe") } else call remark("No command in message") junk = remove(rmtfil) junk = remove(outfil) DRETURN end #-h- valid8 857 asc 08-dec-82 21:15:09 tools (lblh csam sventek) integer function valid8(comand, from) character comand(ARB), from(MAX_TOK), buf(MAXLINE), temp(MAX_TOK) integer stat, n integer getlin, equal filedes int filedes fopen string file "~msg/rmtxeq.cmd" string sufile "~msg/sufile" stat = NO call strcpy(from, temp) call canonf(temp) call fold(temp) if (fopen(sufile, READ, int) != ERR) { for (n = getlin(buf, int); n != EOF; n = getlin(buf, int)) { buf(n) = EOS call canonf(buf) call fold(buf) if (equal(buf, temp) == YES) { stat = YES break } } call close(int) } if (stat == NO) if (fopen(file, READ, int) != ERR) { for (n=getlin(buf, int); n != EOF; n=getlin(buf, int)) { buf(n) = EOS if (equal(buf, comand) == YES) { stat = YES break } } call close(int) } return(stat) end #-h- smtp.r 13416 asc 05-aug-83 17:16:17 sventek (joseph sventek) #-h- defns 436 asc 11-oct-82 06:56:16 sventek (joseph sventek) define(AVE_TOK_SIZE,20) # size of average address token define(MEM_SIZE,arith(250,*,AVE_TOK_SIZE)) define(BSYN,0) # syntax error - invalid command define(HELO,1) # the exact SMTP commands - see RFC821 define(MAIL,2) define(RCPT,3) define(DATA,4) define(RSET,5) define(SEND,6) define(SOML,7) define(SAML,8) define(VRFY,9) define(EXPN,10) define(HELP,11) define(NOOP,12) define(QUIT,13) define(TURN,14) include mailsym include smtpsym #-h- main 1509 asc 16-jun-83 13:06:30 sventek (joseph sventek) DRIVER(smtp) integer i, status integer netget, dohelo, domail, dorcpt, dodata, dorset, dosend, dosoml, dosaml, dovrfy, doexpn, dohelp, donoop, doquit, dobsyn, netput, comtyp, sminit, doturn character buf(MAXLINE), resp(MAXLINE) ifdef(CONTINUOUS_SERVER) repeat { enddef if (sminit(resp) == ERR) { call ptdate(ERROUT) call remark("Error accepting connect request") } else if (netput(resp) != ERR) { while (netget(buf) != EOF) { i = 1 switch(comtyp(buf, i)) { case HELO: status = dohelo(buf, i, resp) case MAIL: status = domail(buf, i, resp) case RCPT: status = dorcpt(buf, i, resp) case DATA: status = dodata(buf, i, resp) case RSET: status = dorset(buf, i, resp) case SEND: status = dosend(buf, i, resp) case SOML: status = dosoml(buf, i, resp) case SAML: status = dosaml(buf, i, resp) case VRFY: status = dovrfy(buf, i, resp) case EXPN: status = doexpn(buf, i, resp) case HELP: status = dohelp(buf, i, resp) case NOOP: status = donoop(buf, i, resp) case QUIT: status = doquit(buf, i, resp) case TURN: status = doturn(buf, i, resp) case BSYN: status = dobsyn(buf, i, resp) } if (resp(1) != EOS) # there is a response { if (netput(resp) == ERR) break } if (status == EOF) break } } call smfini ifdef(CONTINUOUS_SERVER) } enddef DRETURN end #-h- comtyp 1318 asc 14-jan-83 13:31:08 sventek (joseph sventek) integer function comtyp(buf, i) character buf(ARB), name(5) integer i, j, status integer equal string helost "helo" string mailst "mail" string rcptst "rcpt" string datast "data" string rsetst "rset" string sendst "send" string somlst "soml" string samlst "saml" string vrfyst "vrfy" string expnst "expn" string helpst "help" string noopst "noop" string quitst "quit" string turnst "turn" for (j=1; j <= 4; j=j+1, i=i+1) name(j) = buf(i) name(j) = EOS if (buf(i) != ' ' & buf(i) != '@n') return(BSYN) # bad syntax call fold(name) if (equal(name, helost) == YES) status = HELO else if (equal(name, mailst) == YES) status = MAIL else if (equal(name, rcptst) == YES) status = RCPT else if (equal(name, datast) == YES) status = DATA else if (equal(name, rsetst) == YES) status = RSET else if (equal(name, sendst) == YES) status = SEND else if (equal(name, somlst) == YES) status = SOML else if (equal(name, samlst) == YES) status = SAML else if (equal(name, vrfyst) == YES) status = VRFY else if (equal(name, expnst) == YES) status = EXPN else if (equal(name, helpst) == YES) status = HELP else if (equal(name, noopst) == YES) status = NOOP else if (equal(name, quitst) == YES) status = QUIT else if (equal(name, turnst) == YES) status = TURN else status = BSYN return(status) end #-h- cvtadr 283 asc 27-may-82 13:30:49 j (sventek j) integer function cvtadr(buf, i, addr) character buf(ARB), addr(ARB) integer i integer index, rindex call skipbl(buf, i) if (buf(i) != '<') return(ERR) call scopy(buf, i+1, addr, 1) # collapse address i = rindex(addr, '>') if (i == 0) return(ERR) addr(i) = EOS return(OK) end #-h- dobsyn 121 asc 09-feb-82 21:43:55 j integer function dobsyn(buf, i, resp) character buf(ARB), resp(ARB) integer i integer errsyn return(errsyn(resp)) end #-h- dodata 1271 asc 22-oct-82 16:37:57 sventek (joseph sventek) integer function dodata(buf, i, resp) character buf(ARB), resp(ARB) integer i character buffer(incr(MAX_DATA)), zone(10) integer errseq, errloc, netput, imget, netget, equal, queuit filedes fd filedes fcreat include csmtp string ackmsg "354 Start mail input; end with .@n" string enddat ".@n" string fromst MAIL_FROM_STR string tost RCPT_TO_STR string datast DATA_STR if (start == YES | mbegin == NO) # command sequence error return(errseq(resp)) if (nrcpt == 0) # no valid recipients return(errseq(resp)) mbegin = NO # need a new MAIL cmd if this fails if (fcreat(file, WRITE, fd) == ERR) # cannot create scratch file for MAILER return(errloc(resp)) if (netput(ackmsg) == ERR) { call close(fd) resp(1) = EOS return(EOF) } call angbrk(fromst, sender, fd) while (imget(table, buffer) != EOF) call angbrk(tost, buffer, fd) call putlnl(datast, fd) call puttsl(fd) # output time stamp line in message while (netget(buffer) != EOF) # fetch input lines until @n.@n if (equal(buffer, enddat) == YES) # found the end { call close(fd) return(queuit(resp)) } else { if (buffer(1) == '.') call scopy(buffer, 2, buffer, 1) call putlin(buffer, fd) } call close(fd) resp(1) = EOS return(EOF) end #-h- doexpn 121 asc 09-feb-82 21:43:56 j integer function doexpn(buf, i, resp) character buf(ARB), resp(ARB) integer i integer errimp return(errimp(resp)) end #-h- dohelo 402 asc 27-may-82 13:11:50 j (sventek j) integer function dohelo(buf, i, resp) character buf(ARB), resp(ARB) integer i, junk, j integer getwrd include csmtp string numstr "250 " start = NO # indicate that HELO has been seen junk = getwrd(buf, i, fhost) # fetch the host name of sender j = 1 call stcopy(numstr, 1, resp, j) # response to helo command call stcopy(myhost, 2, resp, j) # ... call chcopy('@n', resp, j) # ... return(OK) end #-h- dohelp 121 asc 09-feb-82 21:43:57 j integer function dohelp(buf, i, resp) character buf(ARB), resp(ARB) integer i integer errimp return(errimp(resp)) end #-h- domail 600 asc 27-may-82 13:45:04 j (sventek j) integer function domail(buf, i, resp) character buf(ARB), resp(ARB) integer i integer errpar, erradr, errseq, stncmp, cvtadr, okresp, errloc pointer iminit include csmtp string fromst "from:" if (start == YES | mbegin == YES) # bad command sequence return(errseq(resp)) call skipbl(buf, i) if (stncmp(buf, i, fromst, 5) == NO) # bad command parameter return(errpar(resp)) i = i + 5 if (cvtadr(buf, i, sender) == ERR) # bad address syntax return(erradr(resp)) table = iminit(MEM_SIZE,AVE_TOK_SIZE) if (table == LAMBDA) return(errloc(resp)) nrcpt = 0 mbegin = YES return(okresp(resp)) end #-h- donoop 121 asc 09-feb-82 21:43:58 j integer function donoop(buf, i, resp) character buf(ARB), resp(ARB) integer i integer okresp return(okresp(resp)) end #-h- doquit 290 asc 27-may-82 13:11:51 j (sventek j) integer function doquit(buf, i, resp) character buf(ARB), resp(ARB) integer i include csmtp string numstr "221 " string tail " Service closing transmission channel@n" j = 1 call stcopy(numstr, 1, resp, j) call stcopy(myhost, 2, resp, j) call stcopy(tail, 1, resp, j) return(EOF) end #-h- dorcpt 1163 asc 28-may-82 07:35:38 j (sventek j) integer function dorcpt(buf, i, resp) character buf(ARB), resp(ARB), addr(MAX_TOK) integer i, j integer errseq, stncmp, cvtadr, okresp, errpar, erradr, imput, match1, length include csmtp string tost "to:" string answer "452 Requested action not taken; insufficient system storage@n" if (start == YES | mbegin == NO) # bad command sequence return(errseq(resp)) call skipbl(buf, i) # skip leading blanks if (stncmp(buf, i, tost, 3) == NO) # to: string return(errpar(resp)) # bad command parameter i = i + 3 if (cvtadr(buf, i, addr) == ERR) # bad address syntax return(erradr(resp)) call rotate(addr) # remove our host name from front if (match1(addr, myhost) == YES) # ... { # ... j = length(myhost) + 1 # ... if (addr(j) == ',') # remove it call scopy(addr, j+1, addr, 1) # ... } # ... ifdef(DO_SYNONYMS) # for debug only if (match1(addr, "@lbli,") == YES) # for debug only call scopy(addr, 7, addr, 1) # for debug only enddef # for debug only call unrot8(addr) # ... if (imput(table, addr) == ERR) # out of storage { call strcpy(answer, resp) return(ERR) } nrcpt = nrcpt + 1 return(okresp(resp)) end #-h- dorset 197 asc 09-feb-82 21:44:01 j integer function dorset(buf, i, resp) character buf(ARB), resp(ARB) integer i integer errseq, okresp include csmtp if (start == YES) return(errseq(resp)) mbegin = NO return(okresp(resp)) end #-h- dosaml 153 asc 11-oct-82 06:56:22 sventek (joseph sventek) integer function dosaml(buf, i, resp) character buf(ARB), resp(ARB) integer i integer domail return(domail(buf, i, resp)) # just do Mail command end #-h- dosend 121 asc 09-feb-82 21:44:02 j integer function dosend(buf, i, resp) character buf(ARB), resp(ARB) integer i integer errimp return(errimp(resp)) end #-h- dosoml 153 asc 11-oct-82 06:56:23 sventek (joseph sventek) integer function dosoml(buf, i, resp) character buf(ARB), resp(ARB) integer i integer domail return(domail(buf, i, resp)) # just do Mail command end #-h- doturn 121 asc 11-oct-82 06:56:26 sventek (joseph sventek) integer function doturn(buf, i, resp) character buf(ARB), resp(ARB) integer i integer errimp return(errimp(resp)) end #-h- dovrfy 121 asc 09-feb-82 21:44:03 j integer function dovrfy(buf, i, resp) character buf(ARB), resp(ARB) integer i integer errimp return(errimp(resp)) end #-h- erradr 143 asc 09-feb-82 21:44:20 j integer function erradr(resp) character resp(ARB) string answer "553 Mailbox syntax incorrect@n" call strcpy(answer, resp) return(ERR) end #-h- errimp 142 asc 09-feb-82 21:44:04 j integer function errimp(resp) character resp(ARB) string answer "502 Command not implemented@n" call strcpy(answer, resp) return(ERR) end #-h- errloc 167 asc 09-feb-82 21:44:21 j integer function errloc(resp) character resp(ARB) string answer "451 Requested action aborted; local processing error@n" call strcpy(answer, resp) return(ERR) end #-h- errpar 158 asc 09-feb-82 21:44:19 j integer function errpar(resp) character resp(ARB) string answer "501 Syntax error in parameters or arguments@n" call strcpy(answer, resp) return(ERR) end #-h- errseq 143 asc 09-feb-82 21:44:06 j integer function errseq(resp) character resp(ARB) string answer "503 Bad sequence of commands@n" call strcpy(answer, resp) return(ERR) end #-h- errsyn 153 asc 09-feb-82 21:44:07 j integer function errsyn(resp) character resp(ARB) string answer "500 Syntax error, command unrecognized@n" call strcpy(answer, resp) return(ERR) end #-h- okresp 120 asc 09-feb-82 21:44:04 j integer function okresp(resp) character resp(ARB) string answer "250 OK@n" call strcpy(answer, resp) return(OK) end #-h- puttsl 717 asc 11-oct-82 06:56:24 sventek (joseph sventek) # output time stamp line on unit fd subroutine puttsl(fd) filedes fd integer i, now(7) character date(10), time(10), zone(4) include csmtp string head "Received: from " string netw NETWORK_TYPE string with " with " string rcvd " by " string semi " ; " call putlin(head, fd) call putlin(fhost, fd) call putlin(rcvd, fd) call putlin(myhost(2), fd) if (netw(1) != EOS) { call putlin(with, fd) call putlin(netw, fd) } call putlin(semi, fd) call getnow(now) call gtzone(zone) call fmtdat(date, time, now, LETTER) for (i = 1; date(i) != EOS; i = i + 1) if (date(i) == '-') date(i) = ' ' call putlin(date, fd) call putch(' ', fd) call putlin(time, fd) call putch(' ', fd) call putlnl(zone, fd) return end #-h- queuit 263 asc 09-feb-82 22:25:32 j integer function queuit(resp) character resp(ARB) integer okresp, sndmlr include csmtp string answer "554 Transaction failed; MAILER not responding@n" if (sndmlr(file) == ERR) { call strcpy(answer, resp) return(ERR) } else return(okresp(resp)) end #-h- smfini 107 asc 22-apr-82 10:30:13 j (sventek j) subroutine smfini integer junk integer remove include csmtp junk = remove(file) call netfin return end #-h- sminit 452 asc 27-may-82 13:11:54 j (sventek j) integer function sminit(resp) character resp(ARB) integer i, status integer initrx include csmtp DS_DECL(Mem,MEM_SIZE) string numstr "220 " string tail " Service ready@n" string seed "mtp" string pname "smtp?" call minit(pname) # enable use of IPC start = YES mbegin = NO call scratf(seed, file) status = initrx(myhost) i = 1 call stcopy(numstr, 1, resp, i) call stcopy(myhost, 2, resp, i) call stcopy(tail, 1, resp, i) return(status) end #-h- stncmp 264 asc 14-jan-83 13:31:13 sventek (joseph sventek) integer function stncmp(buf, start, pat, n) character buf(ARB), pat(ARB), c1, c2 character clower integer start, n, i, j for (i=start, j=1; j <= n; i=i+1, j=j+1) { c1 = clower(buf(i)) c2 = clower(pat(j)) if (c1 != c2) return(NO) } return(YES) end #-h- smtpsym 22 asc 05-aug-83 17:16:23 sventek (joseph sventek) define(MAX_DATA,1000) #-h- smtptx.r 4335 asc 05-aug-83 17:16:25 sventek (joseph sventek) #-h- defns 16 asc 01-jul-82 13:22:18 j (sventek j) include mailsym #-h- smtptx 4176 asc 13-may-83 16:23:43 sventek (joseph sventek) integer function smtptx(thost, rcvbuf, file, nref, efile) character thost(HOST_SIZE), fhost(HOST_SIZE), rcvbuf(MAXLINE), sndbuf(MAXLINE) character file(FILENAMESIZE), efile(FILENAMESIZE), from(MAX_TOK) integer status, junk, i, nok, nref integer inittx, netget, netput, getlin, match1, adrpth, sndrcv, index, rindex, note, remove filedes fd, efd filedes fopen, fcreat linepointer addr external netget, netput string datast "DATA@n" string quitst "QUIT@n" string termn8 ".@n" string fromst MAIL_FROM_STR string arrstr ARRIVAL_TIME_STR string tail ">@n" if (fopen(file, READ, fd) == ERR) { call errlog("Error opening input file: ", file, L_INT) return(ERR) } if (fcreat(efile, WRITE, efd) == ERR) { call close(fd) call errlog("Error creating scratch file: ", efile, L_INT) return(ERR) } if (inittx(thost, fhost) == ERR) { call close(fd) call close(efd) junk = remove(efile) call errlog("Error establishing SMTP connection to ", thost, L_COMM) return(ERR) } status = ERR call putlnl("SMTP receiver refused these addresses", efd) nok = 0 nref = 0 if (netget(rcvbuf) == EOF) call errlog("Error receiving startup banner from host ", thost, L_COMM) else { call errlog("R: ", rcvbuf, L_BABBLE) i = 1 call stcopy("Helo ", 1, sndbuf, i) call stcopy(fhost, 2, sndbuf, i) call chcopy('@n', sndbuf, i) if (sndrcv(sndbuf, netput, rcvbuf, netget) != OK) { call errlog("Error sending HELO command to ", thost, L_COMM) goto 100 } if (getlin(sndbuf, fd) == ERR) { call errlog("Invalid input file: ", file, L_INT) goto 100 } call xtrpth(sndbuf, from) # get address call pthadr(from, rcvbuf) # convert to name@host... call concat(rcvbuf, fhost, sndbuf) # add our host name junk = adrpth(sndbuf, rcvbuf) # back to path format i = 1 call stcopy(fromst, 1, sndbuf, i) call chcopy('<', sndbuf, i) call stcopy(rcvbuf, 1, sndbuf, i) call stcopy(tail, 1, sndbuf, i) if (sndrcv(sndbuf, netput, rcvbuf, netget) != OK) { call errlog("Error sending MAIL FROM command to ", thost, L_COMM) goto 100 } while (getlin(sndbuf, fd) != EOF) { if (match1(sndbuf, arrstr) == YES) break stat = sndrcv(sndbuf, netput, rcvbuf, netget) if (stat == EOF) { call errlog("Error sending RCPT TO command to ", thost, L_COMM) goto 100 } if (stat == ERR) # receiver dislikes address { i = index(sndbuf, '<') call scopy(sndbuf, i, sndbuf, 1) i = rindex(sndbuf, '@n') call stcopy(" (", 1, sndbuf, i) call scopy(rcvbuf, 1, sndbuf, i) call skipto(sndbuf, i, '@n') sndbuf(i) = ')' call errlog("Address refused by receiver: ", sndbuf, L_TRACE) nref = nref + 1 call putlnl(sndbuf, efd) } else nok = nok + 1 } if (match1(sndbuf, arrstr) == NO) goto 100 if (nok <= 0) # no good addresses { call errlog("No valid addresses in file: ", file, L_TRACE) status = OK } else { if (sndrcv(datast, netput, rcvbuf, netget) != OK) { call errlog("Error sending DATA command to ", thost, L_COMM) goto 100 } junk = note(addr, fd) while (getlin(sndbuf, fd) != EOF) { call scrypt(sndbuf) # decrypt buffer if (sndbuf(1) == '.') # add transparency { rcvbuf(1) = '.' call scopy(sndbuf, 1, rcvbuf, 2) call strcpy(rcvbuf, sndbuf) } if (netput(sndbuf) == ERR) { call errlog("Error sending line of message to ", thost, L_COMM) goto 100 } } if (sndrcv(termn8, netput, rcvbuf, netget) != OK) { call errlog("Error sending termination message to ", thost, L_COMM) goto 100 } status = OK } if (sndrcv(quitst, netput, rcvbuf, netget) != OK) call errlog("Error sending QUIT command to ", thost, L_COMM) } 100 continue if (nref > 0 & status == OK) # some addresses were not valid { call angbrk(fromst, from, efd) call seek(addr, fd) call fcopy(fd, efd) call close(efd) } else { call close(efd) junk = remove(efile) } call close(fd) call netfin return(status) end #-h- smtpxmt.r 1201 asc 05-aug-83 17:16:28 sventek (joseph sventek) #-h- main 1124 asc 05-aug-83 14:15:20 sventek (joseph sventek) include mailsym DRIVER(txsmtp) character buf(MAXLINE), host(HOST_SIZE), file(FILENAMESIZE), temp(HOST_SIZE), efile(FILENAMESIZE) integer status, access, level, i, j, nref, junk integer getarg, smtptx, ctoi, remove filedes fd filedes fopen string usestr "usage: " string tail " [-log_level] host 0) # have some returns, copy to STDOUT if (fopen(efile, READ, fd) != ERR) # open the file { call fcopy(fd, STDOUT) call close(fd) junk = remove(efile) } } call endst(status) end #-h- sndbuf 181 asc 05-aug-83 17:16:29 sventek (joseph sventek) common / scrbuf / buf(MAXLINE), defn(DEF_SIZE) character buf # scratch buffer used for getlin's throughout character defn # array to hold definitions from table lookup #-h- sndmsg.r 21945 asc 05-aug-83 17:16:34 sventek (joseph sventek) #-h- defns 146 asc 25-may-82 11:26:53 j (sventek j) define(DO_ALL,1) define(DO_FIRST,2) define(TERMEOF,"^Z") define(USERWIDTH,15) define(BLIND_CC,YES) define(NO_BLIND_CC,NO) include mailsym #-h- main 1721 asc 16-jun-83 13:49:19 sventek (joseph sventek) DRIVER(sndmsg) integer junk integer genmsg, remove include csndm include sndscr include sndbuf string tos "To: " string ccs "Cc: " string bccs "Bcc: " string errmsg "No valid user names specified" string smx "smx" call query("usage: sndmsg") call sndint # initialize tblook table call sndcmd # process command arguments nusers = 0 # initialize number of users call sndadr(tofile, temp1, tos) # get To addresses nto = nusers call sndadr(ccfile, temp2, ccs) # get Cc addresses ncc = nusers - nto call sndadr(bcfile, temp3, bccs) # get Bcc addresses nbcc = nusers - nto - ncc call getsbj(subjct) # get subject string call gtrcpt # see if return receipt desired if (genmsg(msgfil, temp4) == OK) # get body of message { if ((nto + ncc + nbc) <= 0) # no valid users call snderr(errmsg) if (dorcpt == YES) call ckauth # make sure author gets a copy if ((nto + ncc) > 0) # To and cc submitted together { call pstmrk(temp0, NO_BLIND_CC) # To and cc do not see bcc recipients call fappd(temp0, temp4) # concatenate message to header call scratf(smx, defn) # generate temp file with merged lists call fappd(defn, temp1) # ... call fappd(defn, temp2) # ... call sdmail(temp0, defn) # send to To & cc addresses junk = remove(defn) # eliminate temp file } if (nbcc > 0) # send blind carbons { call pstmrk(temp0, BLIND_CC) # bcc recipients see their addresses call fappd(temp0, temp4) # concatenate message to header call sdmail(temp0, temp3) # send to Bcc addresses } } call cleanf # clean up temp files DRETURN end #-h- addusr 284 asc 25-may-82 11:26:55 j (sventek j) subroutine addusr(user, file, unit) integer unit character user(USERSIZE), file(FILENAMESIZE) include sndscr include csndm nusers = nusers + 1 call putch('<', unit) call putlin(file, unit) call putch('>', unit) call putch(GS, unit) call putlnl(user, unit) return end #-h- adhelp 605 asc 16-jun-83 13:49:21 sventek (joseph sventek) subroutine adhelp call remark("Valid responses to the To , cc and Bcc prompts are sequences") call remark("of addresses separated by commas. To terminate prompting") call remark("for a particular field, simply type a carriage return") call remark("in response to the prompt") call putch('@n', ERROUT) call remark("Valid forms for an address field are:") call putch('@n', ERROUT) call remark("address: username") call remark(" : myself") call remark(" : alias") call remark(" : address@host") call remark(" : address at host") call putch('@n', ERROUT) return end #-h- appded 388 asc 16-jun-83 13:49:22 sventek (joseph sventek) subroutine appded(int, file, buf) filedes int, out, fcreat character file(ARB), buf(MAXLINE) integer getlin, equal string term ".@n" if (fcreat(file, APPEND, out) == ERR) call remark("Error opening buffer file") else { while (getlin(buf, int) != EOF) { if (equal(buf, term) == YES) break else call putlin(buf, out) } call close(out) } return end #-h- cleanf 192 asc 30-mar-82 13:56:12 v1.1 (sw-tools v1.1) subroutine cleanf integer junk integer remove include sndscr junk = remove(temp0) junk = remove(temp1) junk = remove(temp2) junk = remove(temp3) junk = remove(temp4) return end #-h- dotcst 910 asc 08-feb-83 11:39:22 sventek (joseph sventek) subroutine dotcst(file, pstr, out, user) integer out, i, j, n, lm integer length, getlin, index filedes in, fopen character user(MAXLINE), file(ARB), pstr(ARB) if (fopen(file, READ, in) == ERR) return i = getlin(user, in) if (i != EOF) { lm = length(pstr) + 1 call putlin(pstr, out) j = lm for ( ; i != EOF; i = getlin(user, in)) { user(i) = EOS i = index(user, GS) + 1 call scopy(user, i, user, 1) n = j + length(user) + 1 if (n > RIGHT_MARGIN) { call putch(',', out) call putch('@n', out) for (j = 1; j < lm; j = j + 1) call putch(' ', out) } if (j > lm) call putch(',', out) call putch(' ', out) call putlin(user, out) j = j + length(user) + 2 } call putch('@n', out) } call close(in) return end #-h- editit 512 asc 16-jun-83 14:12:46 sventek (joseph sventek) subroutine editit(editor, file, buf) character file(FILENAMESIZE), buf(ARB), proc(FILENAMESIZE), pid(PIDSIZE) character editor(ARB) integer i, spawn, loccom string suffix IMAGE_SUFFIX string spath STD_PATH string local "local" if (loccom(editor, spath, suffix, proc) != BINARY) call strcpy(local, proc) i = 1 call stcopy(editor, 1, buf, i) call chcopy(' ', buf, i) call scopy(file, 1, buf, i) if (spawn(proc, buf, pid, WAIT) != OK) call remark("Error in spawning editor!") return end #-h- fappd 352 asc 26-oct-82 16:15:55 sventek (joseph sventek) subroutine fappd(dest, source) filedes out, in filedes fcreat, fopen character getch character c character dest(FILENAMESIZE), source(FILENAMESIZE) if (fcreat(dest, APPEND, out) != ERR) { if (fopen(source, READ, in) != ERR) { while (getch(c, in) != EOF) call putch(c, out) call close(in) } call close(out) } return end #-h- genmsg 658 asc 22-oct-82 16:47:53 sventek (joseph sventek) integer function genmsg(infile, outfil) character infile(ARB), outfil(ARB) filedes out, int filedes fcreat, open integer isatty, texted integer stat string errmsg "Error generating message to send!" if (fcreat(outfil, WRITE, out) == ERR) call snderr(errmsg) if (infile(1) != EOS) int = open(infile, READ) else int = STDIN if (int == ERR) { call close(out) call snderr(errmsg) } if (isatty(int) == NO) call fcopy(int, out) call close(out) if (isatty(int) == YES) stat = texted(int, outfil) else if (int != STDIN & isatty(STDIN) == YES) stat = texted(STDIN, outfil) else stat = OK if (int != STDIN) call close(int) return(stat) end #-h- getsbj 283 asc 30-mar-82 13:56:19 v1.1 (sw-tools v1.1) subroutine getsbj(subjct) character subjct(MAXLINE) integer n integer prompt, isatty string pstr "Subject: " if (subjct(1) == EOS & isatty(STDIN) == YES) { n = prompt(pstr, subjct, STDIN) if (n > 0) subjct(n) = EOS else subjct(1) = EOS } return end #-h- helped 1187 asc 16-jun-83 13:49:25 sventek (joseph sventek) subroutine helped call remark("Valid commands are:") call putch('@n', ERROUT) call remark("a[ppend] - append terminal input to message") call remark(" - terminate input with a bare period ('.')") call remark("b[cc] - add addresses to Bcc: field") call remark("c[c] - add addresses to cc: field") call remark("e[dit][ editor] - edit the message using 'editor'") call remark("h[elp] - print this display") call remark("i[nsert] - insert terminal input at beginning of message") call remark(" - terminate input with a bare period ('.')") call remark("l[ist] t[o]/c[c]/b[cc]/h[eader]/m[essage]/a[ll]") call remark(" - list contents of appropriate field") call remark("q[uit][!] - quit ... don't send message") call remark("r[ead] file - include contents of 'file' at end of message") call remark("s[end] - send message and exit") call remark("t[o] - add addresses to To: field") call remark("? - synonym for help") call remark(" - does nothing") call putch('@n', ERROUT) call remark("Any other input results in an error message") return end #-h- pstmrk 197 asc 08-feb-83 11:53:05 sventek (joseph sventek) subroutine pstmrk(file, ifbcc) integer ifbcc filedes int, fcreat character file(FILENAMESIZE) if (fcreat(file, WRITE, int) != ERR) { call fmthdr(int, ifbcc) call close(int) } return end #-h- sdmail 1750 asc 16-jun-83 13:49:26 sventek (joseph sventek) subroutine sdmail(msg, mlist) integer nadr, stat, i, notify, junk integer getlin, sndmlr, remove, adrpth, rindex, savmsg filedes inp, out, fopen, fcreat character msg(ARB), mlist(ARB), scrfil(FILENAMESIZE), file(FILENAMESIZE) include csndm include sndbuf string mlr "mlr" string msg0 "The message has been saved on file: " string fromst MAIL_FROM_STR string tost RCPT_TO_STR string datast DATA_STR string deadfl "dead.ltr" data notify /YES/ call scratf(mlr, scrfil) nadr = 0 if (fopen(mlist, READ, inp) != ERR) { if (fcreat(scrfil, WRITE, out) == ERR) call close(inp) else { junk = adrpth(reply2, buf) i = rindex(buf, '@@') buf(i) = EOS call angbrk(fromst, buf, out) while (getlin(buf, inp) != EOF) { nadr = nadr + 1 i = 1 call skipto(buf, i, GS) call chcopy('@n', buf, i) call putlin(tost, out) call putlin(buf, out) } call close(inp) if (nadr == 0) { call close(out) junk = remove(scrfil) return } if (fopen(msg, READ, inp) != ERR) { call putlnl(datast, out) while (getlin(buf, inp) != EOF) call putlin(buf, out) call close(inp) } call close(out) if (notify == YES) { notify = NO call remark("Submitting mail to MAILER") } stat = sndmlr(scrfil) if (stat == ERR) { call homdir(file, LOCAL) call concat(file, deadfl, file) if (savmsg(scrfil, file) == OK) { call logmsg(msg0, file, ERROUT) call remark("Use mretry to resubmit the message at a later time") } else call remark("Message lost - notify system manager") } junk = remove(scrfil) } } return end #-h- sndadr 1097 asc 22-oct-82 16:47:58 sventek (joseph sventek) subroutine sndadr(infile, outfil, pstr) character infile(ARB), outfil(ARB), pstr(ARB) integer prompt, gtmtok integer stat, naddr, junk, n integer equal, isatty, remove, length filedes int, out, open, fcreat include sndbuf string msg1 "Invalid user name: " string trm "@"" bp = 0 if (infile(1) == EOS) if (isatty(STDIN) == YES) int = STDIN else int = ERR else int = open(infile, READ) if (int == ERR) return naddr = 0 if (fcreat(outfil, WRITE, out) != ERR) { while (prompt(pstr, buf, int) != EOF) { if (buf(1) == '?') call adhelp else if (buf(1) == '@n') break else { n = length(buf) buf(n) = EOS call pbmtok(buf, PB_SIZE) for (stat=gtmtok(buf,defn,trm); stat!=EOF; stat=gtmtok(buf,defn,trm)) if (stat == ERR) call logmsg(msg1, buf, ERROUT) else { call addusr(buf, defn, out) naddr = naddr + 1 } } } call close(out) } if (naddr == 0) # nothing done, remove file junk = remove(outfil) if (int != STDIN) call close(int) return end #-h- sndcmd 1002 asc 09-feb-83 16:02:57 sventek (joseph sventek) subroutine sndcmd integer i integer getarg, equal character clower include csndm include sndbuf dorcpt = NO tofile(1) = EOS ccfile(1) = EOS bcfile(1) = EOS msgfil(1) = EOS reply(1) = EOS sender(1) = EOS subjct(1) = EOS msgids(1) = EOS for (i=1; getarg(i, buf, MAXARG) != EOF; i=i+1) if (buf(1) == '-') { c = clower(buf(2)) if (c == 't') call scopy(buf, 3, tofile, 1) else if (c == 'c') call scopy(buf, 3, ccfile, 1) else if (c == 'b') call scopy(buf, 3, bcfile, 1) else if (c == 's') call scopy(buf, 3, subjct, 1) else if (c == 'm') call scopy(buf, 3, msgfil, 1) else if (c == 'r') call scopy(buf, 3, reply, 1) else if (c == '@@') { call strcpy(reply2, sender) # save address as sender call scopy(buf, 3, reply2, 1) call scrypt(reply2) call concat(reply2, hostnm, reply2) } else call badarg(buf) } else call badarg(buf) return end #-h- snderr 90 asc 30-mar-82 13:56:32 v1.1 (sw-tools v1.1) subroutine snderr(buf) character buf(ARB) call cleanf call error(buf) return end #-h- sndint 1451 asc 09-feb-83 16:02:58 sventek (joseph sventek) subroutine sndint character file(FILENAMESIZE), name(FILENAMESIZE), tbuf(FILENAMESIZE) integer i integer rindex include csndm include sndscr include sndbuf DS_DECL(Mem,MEM_SIZE) # declare dynamic storage for symbol table PB_DECL(PB_SIZE) # declare storage for push back buf INCLUDE_CMSG_TABLE string sm0 "sm0" string sm1 "sm1" string sm2 "sm2" string sm3 "sm3" string sm4 "sm4" string addr "address" string malias "malias" string hnames "hnames" string plus "+" string null "" string myself "myself" string start "@"~" string ats " @@ " string defalt "default" call initbl(MEM_SIZE) call getdir(MSGDIRECTORY, LOCAL, name) call concat(name, addr, file) call laddrs(file, buf, tbuf, defn, plus) call concat(name, malias, file) call lalias(file, buf, tbuf, defn, plus) call homdir(name, LOCAL) call concat(name, malias, file) call lalias(file, buf, tbuf, defn, null) call lalias(malias, buf, tbuf, defn, null) call concat(name, hnames, file) call lhosts(file, buf, tbuf, defn) call mailid(reply2) call concat(start, reply2, defn) i = 1 call skipto(defn, i, ' ') call chcopy('"', defn, i) call entdef(myself, defn, adrtbl) # myself ==> ~user call gthost(defalt, hostnm) call concat(reply2, hostnm, reply2) i = rindex(reply2, '@@') call chrstr(reply2, i, ats) call scratf(sm0, temp0) call scratf(sm1, temp1) call scratf(sm2, temp2) call scratf(sm3, temp3) call scratf(sm4, temp4) return end #-h- texted 3458 asc 16-jun-83 13:49:30 sventek (joseph sventek) integer function texted(int, file) filedes int, in filedes fopen integer i, junk, stat, value integer prompt, index, getwrd character file(ARB), incfil(FILENAMESIZE), c character clower include sndbuf include sndscr include csndm string pstr "sm> " string sure "Are you sure? [y/n] " string ed "ed" string filpst "filename: " string what "what? " string bccs "Bcc: " string ccs "cc: " string tos "To: " call remark("Type h for help") while (prompt(pstr, buf, int) != EOF) { i = 1 call skipbl(buf, i) # skip leading blanks c = clower(buf(i)) switch (c) { case '@n': ; # do nothing on newlines case 'q', 's': { value = YES if (index(buf, '!') == 0) # prompt for verification { junk = prompt(sure, buf, int) if (clower(buf(1)) != 'y') value = NO } if (value == YES) if (c == 'q') return(ERR) else return(OK) } case 'a': call appded(int, file, buf) case 'i': call insted(int, file, buf, incfil) case 'h','?': call helped case 'l': { call skipto(buf, i, ' ') if (buf(i) == EOS) { junk = prompt(what, buf, int) i = 1 } call skipbl(buf, i) c = clower(buf(i)) switch (c) { case 'b': call dotcst(temp3, bccs, ERROUT, buf) case 'c': call dotcst(temp2, ccs, ERROUT, buf) case 't': call dotcst(temp1, tos, ERROUT, buf) case 'a', 'h', 'm': { if (c != 'm') # header & all call fmthdr(ERROUT, BLIND_CC) if (c != 'h') # message & all { if (fopen(file, READ, in) != ERR) { call fcopy(in, ERROUT) call close(in) } else call remark("Error opening buffer file") } } default: call remark("Cannot list requested field") } } case 'r': { call skipto(buf, i, ' ') stat = getwrd(buf, i, incfil) if (stat == 0) { junk = prompt(filpst, buf, int) i = 1 stat = getwrd(buf, i, incfil) } if (stat > 0) call fappd(file, incfil) else call remark("No filename specified for read") } case 'e': { call skipto(buf, i, ' ') if (getwrd(buf, i, incfil) == 0) call strcpy(ed, incfil) call editit(incfil, file, buf) } case 'p': call remark("Use l[ist] m[essage] command") case 't': call extadr(tos, temp1, nto, incfil) case 'c': call extadr(ccs, temp2, ncc, incfil) case 'b': call extadr(bccs, temp3, nbcc, incfil) default: call remark("Invalid command - type h for help") } } return(ERR) # if exit with EOF end #-h- gtrcpt 260 asc 08-feb-83 10:33:47 sventek (joseph sventek) subroutine gtrcpt integer prompt, isatty include sndbuf include csndm string pstr "Do you want a return receipt? [y/n] " if (isatty(STDIN) == YES) if (prompt(pstr, buf, STDIN) != EOF) if (buf(1) == 'y' | buf(1) == 'Y') dorcpt = YES return end #-h- fmthdr 1363 asc 15-feb-83 07:44:08 sventek (joseph sventek) subroutine fmthdr(int, ifbcc) integer ifbcc, junk integer sndmsg, rcvmsg filedes int include csndm include sndscr include sndbuf string datst "Date: " string frmst "From: " string sndst "Sender: " string subjs "Subject: " string repls "In-Reply-To: " string tos "To: " string ccs "cc: " string bccs "Bcc: " string mailer "mailer" string midmsg MSGID_MESSAGE string idhead "Message-Id: <" string idtail ">@n" string pname "sndmsg?" string rcptst "X-ST-Return-Receipt-Requested:" if (msgids(1) == EOS) { call minit(pname) if (sndmsg(mailer, midmsg) != ERR) junk = rcvmsg(buf, msgids) else msgids(1) = EOS } if (dorcpt == YES & ifbcc == NO_BLIND_CC) call putlnl(rcptst, int) call putlin(datst, int) call ptdate(int) call putlin(frmst, int) call putlnl(reply2, int) if (sender(1) != EOS) { call putlin(sndst, int) call putlnl(sender, int) } if (msgids(1) != EOS) { call putlin(idhead, int) call putlin(msgids, int) call putlin(hostnm, int) call putlin(idtail, int) } if (subjct(1) != EOS) { call putlin(subjs, int) call putlnl(subjct, int) } if (reply(1) != EOS) { call putlin(repls, int) call putlnl(reply, int) } call dotcst(temp1, tos, int, buf) call dotcst(temp2, ccs, int, buf) if (ifbcc == BLIND_CC) call dotcst(temp3, bccs, int, buf) call putch('@n', int) return end #-h- extadr 346 asc 08-feb-83 12:35:05 sventek (joseph sventek) subroutine extadr(pstr, file, num, tmpfil) character pstr(ARB), file(ARB), tmpfil(ARB) integer num, junk integer remove include sndscr string null "" string smy "smy" call scratf(smy, tmpfil) nusers = 0 call sndadr(null, tmpfil, pstr) if (nusers > 0) { call fappd(file, tmpfil) num = num + nusers } junk = remove(tmpfil) return end #-h- ckauth 741 asc 16-jun-83 13:49:33 sventek (joseph sventek) subroutine ckauth integer i, found integer scauth filedes fd filedes open, fcreat include csndm include sndbuf include sndscr call strcpy(reply2, defn) i = 1 call skipto(defn, i, ' ') defn(i) = EOS call fold(defn) found = NO for (i = 1; i <= 3 & found == NO; i = i + 1) { switch (i) { case 1: fd = open(temp1, READ) case 2: fd = open(temp2, READ) case 3: fd = open(temp3, READ) } if (fd != ERR) { found = scauth(fd, buf, defn) call close(fd) } } if (found == NO) # sender not found, add to bcc if (fcreat(temp3, APPEND, fd) != ERR) { call remark("Your address has been added to the bcc list") call addusr(defn, defn, fd) nbcc = nbcc + 1 call close(fd) } return end #-h- scauth 307 asc 08-feb-83 14:15:31 sventek (joseph sventek) integer function scauth(fd, buf, user) filedes fd character buf(MAXLINE), user(ARB) integer i integer getlin, equal while (getlin(buf, fd) != EOF) { i = 1 call skipto(buf, i, GS) buf(i-1) = EOS # overwrite '>' call fold(buf) if (equal(user, buf(2)) == YES) return(YES) } return(NO) end #-h- insted 754 asc 16-jun-83 13:49:34 sventek (joseph sventek) # insted - insert user input at beginning of message buffer subroutine insted(ifd, file, buf, temp) filedes ifd character file(FILENAMESIZE), buf(MAXLINE), temp(FILENAMESIZE) filedes ofd filedes fcreat integer getlin, equal, amove string smt "smt" string term ".@n" call scratf(smt, temp) # generate scratch name if (fcreat(temp, WRITE, ofd) == ERR) # cannot create scratch call remark("Error creating temporary file") else { while (getlin(buf, ifd) != EOF) { if (equal(buf, term) == YES) break call putlin(buf, ofd) } call close(ofd) call fappd(temp, file) # append message text to temp if (amove(temp, file) == ERR) # rename temp to text buffer call remark("Error renaming temporary file") } return end #-h- sndscr 513 asc 05-aug-83 17:16:44 sventek (joseph sventek) common / sndscr / nusers, temp0(FILENAMESIZE), temp1(FILENAMESIZE), temp2(FILENAMESIZE), temp3(FILENAMESIZE), temp4(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 processed Bcc addresses character temp4 # temporary file to hold body of message #-h- subasm.sh 84 asc 05-aug-83 17:16:45 sventek (joseph sventek) ar xv subs.m | ch .mac | ch "%?*$" "mac &=&; lbr msg/rp=&" | sh -v ar t subs.m | rm #-h- subs.m 1769 asc 05-aug-83 17:16:46 sventek (joseph sventek) #-h- inbclr.mac 499 asc 09-feb-83 10:16:20 sventek (joseph sventek) .title inbclr ;+ ; integer function inbclr(value, mask) ; ; the bits set in mask are cleared from value and returned as the ; function value ; the calling parameters are unmodified ;- ap=%5 value=2 mask=4 .psect $r.roi,con,ro,rel,lcl,i .enabl lsb inbclr:: mov @value(ap),r0 ; get value from caller bge 1$ ; value is positive neg r0 ; abs (value) 1$: mov @mask(ap),r1 ; get mask from caller bge 2$ ; mask is positive neg r1 ; abs (mask) 2$: bic r1,r0 ; clear bits return .end #-h- inbset.mac 491 asc 09-feb-83 10:16:21 sventek (joseph sventek) .title inbset ;+ ; integer function inbset(value, mask) ; ; the bits set in mask are set in value and returned as the ; function value ; the calling parameters are unmodified ;- ap=%5 value=2 mask=4 .psect $r.roi,con,ro,rel,lcl,i .enabl lsb inbset:: mov @value(ap),r0 ; get value from caller bge 1$ ; value is positive neg r0 ; abs (value) 1$: mov @mask(ap),r1 ; get mask from caller bge 2$ ; mask is positive neg r1 ; abs (mask) 2$: bis r1,r0 ; set bits return .end #-h- inbtst.mac 548 asc 09-feb-83 10:16:22 sventek (joseph sventek) .title inbtst ;+ ; integer function inbtst(value, mask) ; ; value is anded with mask, with the result returned as the ; function value ; the calling parameters are unmodified ;- ap=%5 value=2 mask=4 .psect $r.roi,con,ro,rel,lcl,i .enabl lsb inbtst:: mov @value(ap),r0 ; get value from caller bge 1$ ; value is positive neg r0 ; abs (value) 1$: mov @mask(ap),r1 ; get mask from caller bge 2$ ; mask is positive neg r1 ; abs (mask) 2$: com r1 ; r1 has bits we are not interested in bic r1,r0 ; get rid of these return .end #-h- subs.r 43073 asc 05-aug-83 17:16:55 sventek (joseph sventek) #-h- defns 267 asc 21-may-82 13:14:00 j (sventek j) include mailsym define(I_POPEN,common / cpopen / pacc, pint, fcmd(ARGBUFSIZE), tmp(FILENAMESIZE) integer pacc # access mode on temp file filedes pint # unit of "pipe" character fcmd # command associated with "pipe" character tmp # tmp file representing "pipe" ) #-h- adrpth 842 asc 01-dec-82 08:08:40 sventek (joseph sventek) # convert address token to path format integer function adrpth(token, path) character token(MAX_TOK), path(MAX_TOK), temp(MAX_TOK), t, type(25) integer ntok, i, stat, j integer start(25), end(25) integer adscan, gnaddr string quostr "Missing '@"': " string parstr "Missing ')': " ntok = 0 i = 1 repeat { stat = adscan(token, i, j, t, temp) if (stat == ERR) { if (t == QUOTED_STRING) call logmsg(quostr, token, ERROUT) else call logmsg(parstr, token, ERROUT) } else if (stat != EOF) { ntok = ntok + 1 start(ntok) = i end(ntok) = j type(ntok) = t i = j + 1 } } until (stat == EOF | stat == ERR) type(ntok+1) = EOS call strcpy(token, temp) if (stat == EOF) # no syntax errors stat = gnaddr(temp, start, end, type, ntok, token, path) else path(1) = EOS return(stat) end #-h- adscan 1441 asc 14-jan-83 13:48:04 sventek (joseph sventek) integer function adscan(buf, start, end, type, temp) character buf(ARB), temp(MAX_TOK), type integer start, end, j, nlpar, i integer index, equal string trmstr " @t@"(@@<>,:" string ats "at" string vias "via" call skipbl(buf, start) # skip white space j = start # local pointer if (buf(j) == EOS) # scan completed return(EOF) switch (buf(j)) { case '"': # quoted string { type = QUOTED_STRING for (j=j+1; buf(j) != EOS; j=j+1) if (buf(j) == '"') # found terminating quote break if (buf(j) == EOS) # syntax error return(ERR) end = j } case '(': # comment { type = COMMENT nlpar = 1 for (j=j+1; buf(j) != EOS; j=j+1) if (buf(j) == '(') nlpar = nlpar + 1 else if (buf(j) == ')') { nlpar = nlpar - 1 if (nlpar == 0) # found terminating parenthesis break } if (nlpar != 0) # syntax error return(ERR) end = j } case ',', ':', '@@', '<', '>': { type = buf(j) end = j } default: # atom and at, via { for (j=j+1; buf(j) != EOS; j=j+1) if (index(trmstr, buf(j)) > 0) break end = j - 1 for (i=1, j=start; j <= end; i=i+1, j=j+1) temp(i) = buf(j) temp(i) = EOS call fold(temp) if (equal(temp, ats) == YES | equal(temp, vias) == YES) type = '@@' else type = ATOM } } return(type) end #-h- advert 713 asc 30-nov-82 16:31:41 sventek (joseph sventek) integer function advert(addr) character addr(MAX_TOK), temp(MAX_TOK) integer i, j, wall, stat integer index, rindex stat = NO # assume no inversion call strcpy(addr, temp) j = 1 i = index(temp, '@@') if (i == 0) # just call stcopy(temp, 1, addr, j) else { i = i + 1 # skip over '@' call skipto(temp, i, '@@') # find next '@' if (temp(i) == EOS) # just call stcopy(temp, 1, addr, j) else { stat = YES wall = i repeat { i = rindex(temp, '@@') call stcopy(temp, i, addr, j) call chcopy(',', addr, j) temp(i) = EOS } until (i == wall) addr(j-1) = ':' call stcopy(temp, 1, addr, j) } } return(stat) end #-h- angbrk 288 asc 26-may-82 08:37:01 j (sventek j) # routine to output header string, and sandwich token between angle brackets subroutine angbrk(header, token, fd) character header(ARB), token(ARB) filedes fd string tail ">@n" call putlin(header, fd) call putch('<', fd) call putlin(token, fd) call putlin(tail, fd) return end #-h- canond 545 asc 21-may-82 13:14:02 j (sventek j) subroutine canond(date) character date(ARB), c integer i integer type i = 1 call skipto(date, i, DIGIT) # find 'dd' call scopy(date, i, date, 1) # collapse out day_of_week, i = 1 while (type(date(i)) == DIGIT) # find separator i = i + 1 c = date(i) # remember separator call skipto(date, i, ' ') # assume dd-mmm-yy[yy] if (c != '-') # must be of form dd mmm yy[yy] { call skipbl(date, i) call skipto(date, i, ' ') call skipbl(date, i) call skipto(date, i, ' ') } date(i) = EOS # lop off hh:mm:ss - TZONE return end #-h- canonf 326 asc 30-nov-82 22:46:15 sventek (joseph sventek) subroutine canonf(from) character from(ARB), temp(MAX_TOK) integer i, junk integer index, adrpth string at " at " junk = adrpth(from, temp) if (temp(1) == '@@') i = index(temp, ':') + 1 else i = 1 call scopy(temp, i, from, 1) i = index(from, '@@') if (i > 0) call chrstr(from, i, at) # change @ to " at " return end #-h- chrstr 304 asc 14-jan-83 13:48:06 sventek (joseph sventek) ## convert character buf(col) to the string str subroutine chrstr(buf, col, str) character buf(ARB), str(ARB) integer col, n, i, j integer length n = length(str) for (i=length(buf)+1, j=i+n-1; i > col; i=i-1, j=j-1) buf(j) = buf(i) for (j=1; j <= n; j=j+1, col=col+1) buf(col) = str(j) return end #-h- daystr 316 asc 14-jan-83 13:48:07 sventek (joseph sventek) subroutine daystr(day, buf) integer day, i, j character buf(ARB) string days "Sunday@eMonday@eTuesday@eWednesday@eThursday@eFriday@eSaturday" buf(1) = EOS if (day >= 1 & day <= 7) { for (i=1, j=1; i < day; i=i+1, j=j+1) while (days(j) != EOS) j = j + 1 call scopy(days, j, buf, 1) } return end #-h- errlog 392 asc 02-jul-82 12:01:01 j (sventek j) subroutine errlog(first, second, level) character first(ARB), second(ARB) integer level include cloggr if (level <= slevel) # log this message { if (nerrs == 0) # first message this file { call putch('@n', ERROUT) call ptdate(ERROUT) } nerrs = nerrs + 1 call putint(level, 1, ERROUT) call putch(' ', ERROUT) call logmsg(first, second, ERROUT) } return end #-h- fcreat 156 asc 08-jul-82 12:39:43 j (sventek j) filedes function fcreat(file, access, fd) character file(FILENAMESIZE) integer access filedes fd filedes create fd = create(file, access) return(fd) end #-h- fetrst 267 asc 30-nov-82 22:12:48 sventek (joseph sventek) # fetch remainder of header line, skipping header label subroutine fetrst(buf, token) character buf(ARB), token(ARB) integer i, j integer index i = index(buf, ':') + 1 call skipbl(buf, i) for (j=1; buf(i) != '@n'; i=i+1) call chcopy(buf(i), token, j) return end #-h- fopen 151 asc 08-jul-82 12:39:42 j (sventek j) filedes function fopen(file, access, fd) character file(FILENAMESIZE) integer access filedes fd filedes open fd = open(file, access) return(fd) end #-h- gadtok 1038 asc 16-jun-83 13:52:15 sventek (joseph sventek) character function gadtok(token, toksiz) integer toksiz, i character ngetch, type character token(toksiz), c, quote quote = EOS repeat c = ngetch(c, ERR) until (c != ' ' & c != '@t') # gobble leading white space call putbak(c) # put character back for (i=1; i < toksiz; i=i+1) { c = type(ngetch(token(i), ERR)) if (c == '@n' | c == EOF) break if (quote == EOS) # not in quoted string { if (c == ',' | c == ';') # end of token break else if (c == '"') # start of quoted string quote = c else if (c == '<') # start of bracketed address quote = '>' else if (c == ' ' | c == '@t') # suppress multiple whites to ' ' { token(i) = ' ' repeat c = ngetch(c, ERR) # get next character until (c != ' ' & c != '@t') # until non-whitespace call putbak(c) } } else if (quote == c) # end of quoted string quote = EOS } if (i >= toksiz) call remark("token size exceeded") token(i) = EOS # overwrite terminator return(c) end #-h- gnaddr 2398 asc 09-dec-82 23:50:50 sventek (joseph sventek) integer function gnaddr(token, start, end, type, ntok, outtok, addr) character token(ARB), addr(MAX_TOK), outtok(MAX_TOK), type(ARB), lsttyp, nxttyp integer start(ARB), end(ARB), ntok integer i, low, high, j, k, ifbrak, inbrak, atstr integer advert, rindex string blklss " <" string errstr "Missing '>': " # reformat token into outtok to eliminate " at " and " via " addr(1) = EOS # assume invalid token inbrak = NO # not inside <...> low = 0 high = 0 j = 1 atstr = NO for (i = rindex(type, '>') - 1; i > 0; i = i - 1) if (type(i) == '<' | type(i) == ':') break else if (type(i) == ',') { type(i) = ':' k = start(i) token(k) = ':' break } for (i=1; i <= ntok; i=i+1) { if (i > 1 & inbrak == NO) call chcopy(' ', outtok, j) if (type(i) == '<') { inbrak = YES low = i + 1 } else if (type(i) == '>') { inbrak = NO high = i - 1 } if (type(i) == '@@' & inbrak == YES) # output '@@' call chcopy('@@', outtok, j) else { k = start(i) if (type(i) == '@@' & token(k) != '@@') # have an "at" atstr = YES for ( ; k <= end(i); k=k+1) call chcopy(token(k), outtok, j) } } if (low == 0) # no <...> seen { low = 1 high = ntok ifbrak = NO } else if (high < low) # no matching right > { call logmsg(errstr, token, ERROUT) return(ERR) } else # saw <...> { atstr = NO ifbrak = YES } # now generate address for SMTP j = 1 # output pointer lsttyp = '@@' # no leading blank initially for (i=low; i <= high; i=i+1) # scan through range of tokens { nxttyp = type(i) switch (nxttyp) { case '@@', ',', ':': call chcopy(nxttyp, addr, j) case ATOM, QUOTED_STRING: { if (lsttyp == ATOM | lsttyp == QUOTED_STRING) # need blank call chcopy(' ', addr, j) for (k=start(i); k <= end(i); k=k+1) call chcopy(token(k), addr, j) } default: nxttyp = lsttyp # skip comments } lsttyp = nxttyp # remember last type } # update outtok if name @ host @ host form used if (ifbrak == NO) # <...> not seen { k = advert(addr) if (k == YES | atstr == YES) # invert address, if necessary { i = length(outtok) + 1 # must concatenate valid address call stcopy(blklss, 1, outtok, i) call stcopy(addr, 1, outtok, i) call chcopy('>', outtok, i) } } return(OK) end #-h- gtcfil 234 asc 11-oct-82 21:53:10 sventek (joseph sventek) subroutine gtcfil(topic, suffix, file) character topic(ARB), suffix(ARB), file(ARB) integer i string direct TC_DIRECTORY i = 1 call stcopy(direct, 1, file, i) call restop(topic, file, i) call stcopy(suffix, 1, file, i) return end #-h- gtckey 123 asc 11-oct-82 21:53:12 sventek (joseph sventek) subroutine gtckey(topic, key) character topic(ARB), key(KEY_SIZE) integer i i = 1 call restop(topic, key, i) return end #-h- gtconf 265 asc 07-jul-82 08:21:45 j (sventek j) character function gtconf(pstr, pagefd) character pstr(ARB), buf(MAXLINE), c character clower integer prompt filedes pagefd if (pagefd != ERR) { if (prompt(pstr, buf, pagefd) == EOF) c = EOF else c = clower(buf(1)) } else c = 'y' return(c) end #-h- gtmtok 2406 asc 06-dec-82 21:32:41 sventek (joseph sventek) integer function gtmtok(token, defn, trmara) character token(MAX_TOK), defn(DEF_SIZE), name(MAX_TOK), trmara(ARB), c character gadtok integer adrpth, reshst, ludef, index, match1, equal, length integer i INCLUDE_CMSG_TABLE string tcst "tc" string plus "+" string mymail "mymail" string author "author.cpy" string myself "myself" for (c=gadtok(token, MAX_TOK); c != EOF; c=gadtok(token, MAX_TOK)) if (token(1) != EOS) andif (adrpth(token, name) == OK) { if (reshst(name, defn) == YES) # have a network address break call strcpy(defn, name) # use processed name ifnotdef(CASE_IS_SIGNIFICANT) # only fold if !case-sensitive call fold(name) # fold to single case enddef if (ludef(name, defn, alitbl) == NO) # not in alias table { if (index(trmara, name(1)) > 0) # valid terminator character call strcpy(name, defn) # just return that string else # check globally valid stuff { if (name(1) == '"') # escaped address { call scopy(name, 2, name, 1) # eliminate quotes i = length(name) # ... name(i) = EOS # ... } if (match1(name, tcst) == YES & (name(3) == EOS | name(3) == '_' | name(3) == '-')) call strcpy(name, defn) # tc_topic always valid else if (ludef(name, defn, adrtbl) == YES) # valid address { if (equal(defn, plus) == YES) # just use name call strcpy(name, defn) else if (defn(1) == '"') # have ~user call strcpy(myself, name) # address is "myself" else call concat(defn, mymail, defn) } else if(name(1) == '~') { call scopy(name, 2, name, 1) if (ludef(name, defn, adrtbl) == YES) # ~user => ~user/author.cpy call concat(defn, author, defn) else c = ERR } else c = ERR } break } else if (equal(defn, plus) == YES) # "+" ==> terminate scan { call strcpy(name, defn) # just return name break } else # push defn back and go again { call putbak(',') # need separator call pbstr(defn) # push it back } } return(c) end #-h- imatch 276 asc 14-jan-83 13:48:11 sventek (joseph sventek) integer function imatch(buf, n, str) character buf(ARB), str(ARB) character clower integer n, i, j for (i=n, j=1; ; i=i+1, j=j+1) if (str(j) == EOS) return(YES) else if (buf(i) == EOS) break else if (clower(buf(i)) != clower(str(j))) break return(NO) end #-h- initbl 275 asc 21-may-82 15:14:32 j (sventek j) subroutine initbl(size) integer size pointer mktabl INCLUDE_CMSG_TABLE call dsinit(size) # initialize dynamic storage alitbl = mktabl(1) # symbol table for aliases adrtbl = mktabl(1) # symbol table for addresses hsttbl = mktabl(1) # symbol table for hosts return end #-h- jldate 1058 asc 16-jun-83 13:52:19 sventek (joseph sventek) # subroutine to calculate julian date as a double integer from the # calendar date stored as a 7 integer array # this routine is only good for dates between the years 1910 -> 2000 subroutine jldate(cdate, jdate) integer cdate(7), jdate(2), incd(2), y, m, d, i, n, jd(20), md(12) integer leap data jd /241, 8673, 242, 2325, 242, 5978, 242, 9630, 243, 3283, 243, 6935, 244, 0588, 244, 4240, 244, 7893, 245, 1545/ data md /0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334/ y = cdate(1) # year m = cdate(2) # month d = cdate(3) # day if (y < 1910 | y >= 2000) # year out of range { initdi(jdate) call remark("jldate - called with invalid date") return } i = mod((y/10), 10) # index into array of julian dates i = 2 * i - 1 jdate(1) = jd(i) jdate(2) = jd(i+1) n = mod(y, 10) # number of years to accumulate y = y - n incd(1) = 0 for (i=1; i <= n; i=i+1) { incd(2) = 365 + leap(y) # number to add to jdate adddi(incd, jdate) y = y + 1 } incd(2) = md(m) + (m + 10) / 13 * leap(y) + d - 1 adddi(incd, jdate) return end #-h- laddrs 622 asc 22-oct-82 16:54:59 sventek (joseph sventek) subroutine laddrs(file, buf, name, defn, switch) character file(FILENAMESIZE), buf(MAXLINE), name(FILENAMESIZE), defn(ARB) character switch(ARB) integer i, junk, dummy integer getlin, getwrd, equal filedes int, fopen INCLUDE_CMSG_TABLE string plus "+" dummy = equal(switch, plus) if (fopen(file, READ, int) != ERR) { defn(1) = '>' while (getlin(buf, int) != EOF) { i = 1 junk = getwrd(buf, i, name) call fold(name) junk = getwrd(buf, i, defn(2)) if (dummy == YES) call strcpy(plus, defn) call entdef(name, defn, adrtbl) } call close(int) } return end #-h- lalias 2059 asc 16-jun-83 13:52:20 sventek (joseph sventek) subroutine lalias(file, buf, name, defn, switch) character file(FILENAMESIZE), buf(MAXLINE), name(ARB), defn(ARB), switch(ARB) integer i, junk, j, k, dummy, stat filedes int ext_func integer getlin, index, equal, adrpth, addset ext_func filedes fopen INCLUDE_CMSG_TABLE string plus "+" string terms ":?@n" string offlin "Offending line: " string offfil "Offending file: " dummy = equal(switch, plus) if (fopen(file, READ, int) != ERR) { while (getlin(buf, int) != EOF) { i = 1 call skipbl(buf, i) if (buf(i) != '@n' & buf(i) != '#') # something on line { for (j=1; index(terms, buf(i)) == 0; i=i+1) call chcopy(buf(i), defn, j) if (buf(i) == '@n') # bad format in alias file { call remark("Bad format in alias file") call logmsg(offfil, file, ERROUT) call logmsg(offlin, buf, ERROUT) break } junk = adrpth(defn, name) # eliminate comments call fold(name) # assure correct case i = i + 1 # step over terminator j = 1 repeat { stat = OK for (call skipbl(buf, i); buf(i) != EOS; i = i + 1) { if (buf(i) == '@n') buf(i) = ',' if (addset(buf(i), defn, j, DEF_SIZE) == NO) # no room { call remark("Definition field of alias is too large") call logmsg(offfil, file, ERROUT) call logmsg(offlin, buf, ERROUT) stat = ERR break 2 } if (buf(i) == ';') break } if (buf(i) == ';') break stat = getlin(buf, int) i = 1 } until (stat == EOF) defn(j) = EOS if (stat == EOF) { call remark("Unexpected EOF processing alias file") call logmsg(offfil, file, ERROUT) break } if (stat == ERR) break if (dummy == YES) call strcpy(plus, defn) call entdef(name, defn, alitbl) } } call close(int) } return end #-h- leap 349 asc 29-jun-82 09:36:31 j (sventek j) # function to calculate whether a particular year is a leap year or not # returns 1 if YES, 0 if not integer function leap(y) integer y, a, b, c a = (y - y / 4 * 4 + 3) / 4 # divisible by 4 => YES b = (y - y / 100 * 100 + 99) / 100 # divisible by 100 => NO c = (y - y / 400 * 400 + 399) / 400 # divisible by 400 => YES return(1 - a + b - c) end #-h- lhosts 1370 asc 22-oct-82 16:55:04 sventek (joseph sventek) # load host information into lookup table subroutine lhosts(file, buf, name, defn) character file(FILENAMESIZE), buf(MAXLINE), name(FILENAMESIZE), defn(ARB) filedes fd filedes fopen integer i, junk integer getlin, getwrd INCLUDE_CMSG_TABLE string lnames "~msg/lnames" string hnames "~msg/hnames" string lhsstr "&" if (fopen(lnames, READ, fd) != ERR) { while (getlin(buf, fd) != EOF) { i = 1 junk = getwrd(buf, i, name) # gobble network name junk = getwrd(buf, i, name) # fetch @host string call fold(name) # assure correct case call entdef(name, lhsstr, hsttbl) # replace these names with lhs } call close(fd) } if (fopen(hnames, READ, fd) != ERR) { while (getlin(buf, fd) != EOF) { i = 1 junk = getwrd(buf, i, name) # fetch @host string junk = getwrd(buf, i, defn) # fetch replacement text call fold(name) # assure correct case call entdef(name, defn, hsttbl) # install in table } call close(fd) } if (file(1) != EOS) { if (fopen(file, READ, fd) != ERR) { while (getlin(buf, fd) != EOF) { i = 1 junk = getwrd(buf, i, name) # fetch @host string junk = getwrd(buf, i, defn) # fetch replacement text call fold(name) # assure correct case call entdef(name, defn, hsttbl) # install in table } call close(fd) } } return end #-h- logmsg 147 asc 30-jun-82 12:55:22 j (sventek j) subroutine logmsg(first, second, int) character first(ARB), second(ARB) integer int call putlin(first, int) call putlnl(second, int) return end #-h- mgenr8 308 asc 30-jun-82 12:55:22 j (sventek j) subroutine mgenr8(last, seed, file) integer last, i, junk integer gitocf character seed(ARB), file(ARB) string malstr "~msg/" i = 1 call stcopy(malstr, 1, file, i) call stcopy(seed, 1, file, i) junk = gitocf(last, file(i), 4, 30, 3, '0') last = last + 1 if (last >= arith(30,**,3)) last = 0 return end #-h- monstr 354 asc 14-jan-83 13:48:14 sventek (joseph sventek) subroutine monstr(month, buf) integer month, i, j character buf(ARB) string m "January@eFebruary@eMarch@eApril@eMay@eJune@eJuly@eAugust@e_ September@eOctober@eNovember@eDecember" buf(1) = EOS if (month >= 1 & month <= 12) { for (i=1, j=1; i < month; i=i+1, j=j+1) while (m(j) != EOS) j = j + 1 call scopy(m, j, buf, 1) } return end #-h- msgage 1065 asc 14-jan-83 13:48:15 sventek (joseph sventek) integer function msgage(file, buf) character file(ARB), buf(MAXLINE), month(20) character type integer age, getlin, match1, i, then(7), now(7), j, ctoi, strmon integer newdi(2), olddi(2) filedes in, fopen string arrstr ARRIVAL_TIME_STR age = ERR if (fopen(file, READ, in) != ERR) { while (getlin(buf, in) != EOF) if (match1(buf, arrstr) == YES) { i = index(buf, ' ') call scopy(buf, i, buf, 1) # collapse out ARRIVAL_TIME: call canond(buf) i = 1 then(3) = ctoi(buf, i) call skipto(buf, i, LETTER) for (j=1; type(buf(i)) == LETTER; i=i+1, j=j+1) month(j) = buf(i) month(j) = EOS then(2) = strmon(month) call skipto(buf, i, DIGIT) then(1) = ctoi(buf, i) if (then(1) < 100) then(1) = then(1) + 1900 call getnow(now) call jldate(now, newdi) call jldate(then, olddi) subdi(olddi, newdi) age = newdi(2) if (newdi(1) < 0) # letter date precedes now age = newdi(1) break } call close(in) } return(age) end #-h- ncrypt 349 asc 14-jan-83 13:48:17 sventek (joseph sventek) subroutine ncrypt(buf, key) character buf(ARB), key(ARB), c character xor integer i, j, len integer length len = length(key) if (len <= 0) return for (i=1, j=len; buf(i) != EOS; j=len-mod(i,len), i=i+1) { if (buf(i) < ' ') c = buf(i) else c = xor(buf(i), key(j) & 8%37) if (c == DEL) c = buf(i) buf(i) = c } return end #-h- ngetch 317 asc 09-jul-82 11:49:58 j (sventek j) # ngetch - get a (possibly pushed back) character character function ngetch(c, fd) character getch character c integer fd PB_DECL(1) if (pbp > 0) { c = pbbuf(pbp) pbp = pbp - 1 } else if (fd == ERR) c = EOF else c = getch(c, fd) ngetch = c return end #-h- nxthdr 253 asc 30-jun-82 12:55:24 j (sventek j) integer function nxthdr(buf, fd) character buf(MAXLINE) filedes fd integer stat integer getlin, match1 string hdr MSG_HEADER for (stat = getlin(buf, fd); stat != EOF; stat = getlin(buf, fd)) if (match1(buf, hdr) == YES) break return(stat) end #-h- outdat 496 asc 30-jun-82 12:30:21 j (sventek j) subroutine outdat(now, tzone, int) integer int, now(7), day, wkday, i character date(10), time(10), tzone(ARB) string comblk ", " day = wkday(now(2), now(3), now(1)) call daystr(day, date) call putlin(date, int) call putlin(comblk, int) call fmtdat(date, time, now, LETTER) for (i=1; date(i) != EOS; i=i+1) if (date(i) == '-') date(i) = ' ' call putlin(date, int) call putch(' ', int) call putlin(time, int) call putch(' ', int) call putlin(tzone, int) call putch('@n', int) return end #-h- pbdump 380 asc 16-jun-83 13:52:24 sventek (joseph sventek) # pbdump - dump top of pushback stack and set pointer to 0 subroutine pbdump integer i PB_DECL(1) call remark("Too many characters pushed back - dump of top of stack follows") for (pbp=pbp-1, i=1; i <= 75; i=i+1, pbp=pbp-1) if (pbp <= 0) break else call putch(pbbuf(pbp), ERROUT) call putch('@n', ERROUT) call remark("Stack pointer reset to 0") pbp = 0 return end #-h- pbinit 85 asc 09-jul-82 11:49:59 j (sventek j) subroutine pbinit(size) integer size PB_DECL(1) pbp = 0 pbsize = size return end #-h- pbmtok 133 asc 25-may-82 11:56:52 j (sventek j) subroutine pbmtok(token, size) character token(ARB) integer size call pbinit(size) call putbak('@n') call pbstr(token) return end #-h- pbstr 358 asc 09-jul-82 11:50:00 j (sventek j) # pbstr - push string back onto input subroutine pbstr(in) character in(ARB) integer length integer i PB_DECL(1) for (i = length(in); i > 0; i = i - 1) { pbp = pbp + 1 if (pbp > pbsize) { call pbdump # dump stack and reset break } pbbuf(pbp) = in(i) } return end #-h- pclose 240 asc 21-may-82 15:12:04 j (sventek j) integer function pclose(int) filedes int integer stat, xecute, junk, remove I_POPEN if (int != pint) return(ERR) call close(int) pint = ERR if (pacc == WRITE) stat = xecute(fcmd) else stat = OK junk = remove(tmp) return(stat) end #-h- popen 686 asc 21-may-82 15:12:05 j (sventek j) integer function popen(cmd, access, int) character cmd(ARB) integer access, init, xecute, junk, remove filedes int, open, create I_POPEN string seed "pop" string blkgtr " >" string blklss " <" data init /YES/ if (init == YES) { init = NO call scratf(seed, tmp) pint = ERR } if (pint != ERR) { int = ERR return(int) } if (access == READ) { call concat(cmd, blkgtr, fcmd) call concat(fcmd, tmp, fcmd) if (xecute(fcmd) != OK) { junk = remove(tmp) int = ERR } else int = open(tmp, READ) } else { call concat(cmd, blklss, fcmd) call concat(fcmd, tmp, fcmd) int = create(tmp, WRITE) } pint = int pacc = access return(int) end #-h- ptdate 141 asc 30-jun-82 12:30:22 j (sventek j) subroutine ptdate(int) integer int, now(7) character tzone(4) call getnow(now) call gtzone(tzone) call outdat(now, tzone, int) return end #-h- pthadr 382 asc 30-nov-82 16:31:53 sventek (joseph sventek) # subroutine to convert ARPA paths into RFC733 addresses subroutine pthadr(path, addr) character path(ARB), addr(ARB), temp(MAX_TOK) integer i, j integer index, rindex call strcpy(path, temp) j = 1 if (path(1) == '@@') i = index(path, ':') else i = 0 repeat { call stcopy(temp, i+1, addr, j) if (i == 0) break temp(i) = EOS i = rindex(temp, ',') } return end #-h- putbak 224 asc 09-jul-82 11:50:01 j (sventek j) # putbak - push character back onto input subroutine putbak(c) character c PB_DECL(1) pbp = pbp + 1 if (pbp > pbsize) call pbdump # dump stack and reset else pbbuf(pbp) = c return end #-h- reshst 865 asc 26-may-82 12:20:43 j (sventek j) # resolve host names, eliminating any local host names integer function reshst(name, result) character name(MAX_TOK), result(MAX_TOK), temp(MAX_TOK), host(HOST_SIZE) integer i integer rindex, ludef, adrpth INCLUDE_CMSG_TABLE call pthadr(name, temp) # convert to name@host[@host]... repeat { i = rindex(temp, '@@') # scan for last '@@' if (i == 0) # none found break call scopy(temp, i, host, 1) # extract `@host' into buffer call fold(host) # assure correct case if (ludef(host, result, hsttbl) == NO)# host name not found break temp(i) = EOS repeat { i = index(result, '&') if (i > 0) call chrstr(result, i, temp) } until (i == 0) call strcpy(result, temp) } i = adrpth(temp, result) # convert to path address if (rindex(temp, '@@') > 0) # is a network address return(YES) else return(NO) end #-h- restop 615 asc 14-jan-83 13:48:21 sventek (joseph sventek) subroutine restop(topic, obuf, ptr) character topic(ARB), obuf(ARB), toptbl(arith(MAX_NO_TOPICS,*,20)) integer ptr, init, ntops, i, j integer equal data init /YES/ if (init == YES) { init = NO call toplod(ntops, toptbl, arith(MAX_NO_TOPICS,*,20)) } for (i = 1, j = 1; i <= ntops; i = i + 1) { if (equal(topic, toptbl(j)) == YES) { call skipto(toptbl, j, EOS) j = j + 1 call stcopy(toptbl, j, obuf, ptr) return } call skipto(toptbl, j, EOS); j = j + 1 call skipto(toptbl, j, EOS); j = j + 1 } call stcopy(topic, 1, obuf, ptr) # not found, just use topic name return end #-h- rindex 165 asc 30-jun-82 15:45:19 j (sventek j) integer function rindex(buf, c) character buf(ARB), c integer i integer length for (i = length(buf); i > 0; i = i - 1) if (buf(i) == c) break return(i) end #-h- rotate 527 asc 14-jan-83 13:48:22 sventek (joseph sventek) # routine to convert x@y to @y,x in place subroutine rotate(bf) character bf(ARB) integer i, j, k integer index, length if (index(bf, '@@') > 0) { if (bf(1) == '@@') { i = index(bf, ':') # locate colon bf(i) = ',' # change to comma i = i + 1 } else i = 1 j = length(bf) + 1 # first free location bf(j) = ',' # append comma for (k=i, j=j+1; bf(k) != '@@'; k=k+1, j=j+1) bf(j) = bf(k) bf(j) = EOS call scopy(bf, k, bf, i) # collapse @y,x string into place } return end #-h- scnmsg 858 asc 14-mar-83 23:07:04 sventek (joseph sventek) subroutine scnmsg(fd, from, date, subj, buf, ifpath) filedes fd linepointer start character from(ARB), date(ARB), subj(ARB), buf(ARB) integer getlin, match1, note integer junk, ifpath string dates "Date:" string froms "From:" string retpth "Return-Path:" string subjs "Subject:" string hdr MSG_HEADER from(1) = EOS date(1) = EOS subj(1) = EOS junk = note(start, fd) while (getlin(buf, fd) != EOF) { if (buf(1) == '@n') break if (match1(buf, hdr) == YES) break if (date(1) == EOS) if (match1(buf, dates) == YES) call fetrst(buf, date) if (from(1) == EOS) if (match1(buf, froms) == YES) call fetrst(buf, from) else if (match1(buf, retpth) == YES & ifpath == YES) call fetrst(buf, from) if (subj(1) == EOS) if (match1(buf, subjs) == YES) call fetrst(buf, subj) } call seek(start, fd) return end #-h- scrypt 418 asc 14-jan-83 13:48:23 sventek (joseph sventek) subroutine scrypt(buf) character buf(ARB), c character xor integer i, j, len string key "standard-encryption-key" data len/23/ # must jive with length of string above for (i = 1; buf(i) != EOS; i = i + 1) ; for (i = i - 1, j = 1; i > 0; i = i - 1, j = mod(j, len) + 1) { if (buf(i) < ' ') c = buf(i) else c = xor(buf(i), key(j) & 8%37) if (c == DEL) c = buf(i) buf(i) = c } return end #-h- setlog 99 asc 02-jul-82 11:52:49 j (sventek j) subroutine setlog(ndx, value) integer ndx, value include cloggr logvbl(ndx) = value return end #-h- skipto 165 asc 30-jun-82 15:45:16 j (sventek j) subroutine skipto(buf, i, ctype) character buf(ARB) integer i, ctype integer type for ( ; buf(i) != EOS; i=i+1) if (type(buf(i)) == ctype) break return end #-h- sndmlr 539 asc 16-jun-83 13:52:28 sventek (joseph sventek) integer function sndmlr(file) character file(ARB), whofrm(FILENAMESIZE), msg(FILENAMESIZE) integer stat integer isaliv, sndmsg, rcvmsg string mailer "mailer" stat = ERR call strcpy(file, msg) if (isaliv(mailer) == NO) call remark("Mailer not responding") else if (sndmsg(mailer, msg) == ERR) call remark("Cannot contact mailer") else if (rcvmsg(whofrm, msg) == ERR) call remark("Error receiving status from mailer") else if (msg(1) == ERR) call remark("Mailer cannot queue mail delivery") else stat = msg(1) return(stat) end #-h- strmon 332 asc 14-jan-83 13:48:25 sventek (joseph sventek) integer function strmon(buf) character buf(ARB) integer i, j integer imatch string m "January@eFebruary@eMarch@eApril@eMay@eJune@eJuly@eAugust@e_ September@eOctober@eNovember@eDecember" for (i=1, j=1; j <= 12; i=i+1, j=j+1) { if (imatch(m, i, buf) == YES) return(j) while (m(i) != EOS) i = i + 1 } return(0) end #-h- tcexst 248 asc 22-oct-82 16:55:10 sventek (joseph sventek) integer function tcexst(topic) character topic(ARB) filedes fd filedes fopen include cfscr string suffix TC_SUFFIX call gtcfil(topic, suffix, file) if (fopen(file, READ, fd) == ERR) return(NO) else { call close(fd) return(YES) } end #-h- unrot8 515 asc 01-dec-82 21:38:50 sventek (joseph sventek) # routine to convert @y,x to x@y in place subroutine unrot8(bf) character bf(ARB) integer i, j, k integer rindex, length i = rindex(bf, ',') # locate rightmost comma if (i > 0) # something to convert { j = length(bf) + 1 # first free location bf(i) = EOS # overwrite comma k = rindex(bf, ',') # find next comma if (k > 0) # found one bf(k) = ':' k = k + 1 call scopy(bf, k, bf, j) # move @y to proper place call scopy(bf, i+1, bf, k) # collapse x@y into place } return end #-h- valfil 419 asc 22-oct-82 16:55:11 sventek (joseph sventek) integer function valfil(user, bf) character user(USERSIZE), bf(MAXLINE) filedes fd filedes fopen integer stat, n integer getlin, length, equal string file "~msg/sufile" if (fopen(file, READ, fd) == ERR) call cant(file) stat = ERR while (getlin(bf, fd) != EOF) { n = length(bf) bf(n) = EOS call fold(bf) if (equal(bf, user) == YES) { stat = OK break } } call close(fd) return(stat) end #-h- valid8 1424 asc 16-jun-83 13:52:30 sventek (joseph sventek) subroutine valid8(passwd) integer i, j, status integer stmode, equal, getarg, index, valfil character c, bf(MAXLINE), passwd(ARB), user(USERSIZE) character getch string youst "Your name `" string pstr "@r@lPassword? " string invpsw "Invalid password!" string minusp "-p" status = getarg(1, bf, MAXLINE) # see if -p argument call fold(bf) if (status == EOF | equal(bf, minusp) == NO) # prompt for password { if (stmode(STDIN, RARE) != RARE) call error("Cannot set standard input to rare mode") junk = stmode(STDOUT, RARE) for (j=1; j <= 2; j=j+1) { call putlin(pstr, STDOUT) i = 1 while (getch(c, STDIN) != CR) if (c == BS | c == DEL) { if (i > 1) i = i - 1 } else if (c == NAK | c == CAN) i = 1 else if (c == LF) break else { bf(i) = c i = i + 1 } bf(i) = EOS if (equal(bf, passwd) == YES) { call putch(CR, STDOUT) return } call putlin(invpsw, STDOUT) } call putch(CR, STDOUT) call error("Try again later with the correct password") } else { call mailid(user) i = index(user, ' ') if (i > 0) user(i) = EOS call fold(user) if (valfil(user, bf) == ERR) { call putlin(youst, ERROUT) call putlin(user, ERROUT) call error("' has not been granted super-user privileges for the mail system") } } return end #-h- valusr 956 asc 22-oct-82 16:55:13 sventek (joseph sventek) integer function valusr(topic, user, access) character topic(ARB), user(ARB) integer access character matstr(7) integer status, n integer getlin, match1, length, equal filedes fd filedes fopen include cfscr string rdstr ":read" string wtstr ":write" string nfosuf NFO_SUFFIX if (access == READ) call strcpy(rdstr, matstr) else call strcpy(wtstr, matstr) status = YES call gtcfil(topic, nfosuf, file) if (fopen(file, READ, fd) != ERR) { while (getlin(scrbuf, fd) != EOF) if (match1(scrbuf, matstr) == YES) # wants to limit access { status = NO while (getlin(scrbuf, fd) != EOF) if (scrbuf(1) == ':') break else { n = length(scrbuf) scrbuf(n) = EOS call canonf(scrbuf) if (equal(scrbuf, user) == YES) { status = YES break } } break } call close(fd) } return(status) end #-h- xecute 404 asc 16-jun-83 14:15:15 sventek (joseph sventek) integer function xecute(cmd) character cmd(ARB), image(FILENAMESIZE), c, pid(PIDSIZE) integer i, loccom, spawn string suffix IMAGE_SUFFIX string path STD_PATH string local "local" i = 1 call skipto(cmd, i, ' ') c = cmd(i) cmd(i) = EOS if (loccom(cmd, path, suffix, image) != BINARY) call strcpy(local, image) cmd(i) = c if (spawn(image, cmd, pid, WAIT) != OK) return(ERR) else return(OK) end #-h- xor 121 asc 30-jun-82 15:45:20 j (sventek j) # xor - exclusive-or of a and b character function xor(a,b) character a, b xor = (a & !b) | (!a & b) return end #-h- xtrpth 286 asc 14-jan-83 13:48:27 sventek (joseph sventek) # extract bracket-less path from buffer into token subroutine xtrpth(buf, token) character buf(ARB), token(ARB) integer n, i, j integer rindex, index n = rindex(buf, '>') for (i = index(buf, '<') + 1, j = 1; i < n; i = i + 1, j = j + 1) token(j) = buf(i) token(j) = EOS return end #-h- toplod 958 asc 16-jun-83 13:52:32 sventek (joseph sventek) subroutine toplod(ntops, toptbl, size) integer ntops, size, i, j, ovflow character toptbl(size), temp(40), c character getch filedes in filedes fopen string topfil "~msg/topics" ntops = 0 ovflow = NO if (fopen(topfil, READ, in) != ERR) { i = 1 while (getch(temp(1), in) != EOF) # another entry { for (j = 2; ; j = j + 1) { c = getch(temp(j), in) if (c == ' ' | c == '@t') break } temp(j) = EOS if ((i + j) > size) # won't fit { ovflow = YES; break } call stcopy(temp, 1, toptbl, i) i = i + 1 while (c == ' ' | c == '@t') c = getch(temp(1), in) for (j = 2; getch(temp(j), in) != '@n'; j = j + 1) ; temp(j) = EOS if ((i + j) > size) # won't fit { ovflow = YES; break } call stcopy(temp, 1, toptbl, i) i = i + 1 ntops = ntops + 1 } call close(in) if (ovflow == YES) call remark("Toplod - topic table overflow") } return end #-h- savmsg 448 asc 06-dec-82 17:36:00 sventek (joseph sventek) # save the contents of scrfil in file; may be requeued using mretry utility integer function savmsg(scrfil, file) character scrfil(ARB), file(ARB) filedes in, fopen, out, fcreat integer status string hdr "@1@2@n" status = ERR if (fopen(scrfil, READ, in) != ERR) { if (fcreat(file, APPEND, out) != ERR) { call putlin(hdr, out) call fcopy(in, out) call close(out) status = OK } call close(in) } return(status) end #-h- stdump 1433 asc 16-jun-83 13:52:34 sventek (joseph sventek) subroutine stdump(flag, stfile) integer flag character date(16), time(10), stfile(ARB) integer junk, i, now(7) integer ditoc, itoc filedes fd filedes fcreat include cstat string s0 ": could not append statistics; they are included below" string s1 "@n*** Statistics for the period " string s2 " to " string schr "@n*** Number of characters " string sadr "@n*** Number of addresses " string sfil "@n*** Number of input files " if (numfil == 0) # No more work since last dump return if (flag != EOF) # just dump if the date has changed { call getnow(now) # fetch current date if (now(3) == start(3) & now(2) == start(2)) # day & month have not changed return } if (fcreat(stfile, APPEND, fd) == ERR) { call errlog(stfile, s0, L_INT) fd = ERROUT } call putlin(s1, fd) call fmtdat(date, time, start, LETTER) call putlin(date, fd); call putch(' ', fd); call putlin(time, fd) call putlin(s2, fd) call fmtdat(date, time, now, LETTER) call putlin(date, fd); call putch(' ', fd); call putlin(time, fd) junk = ditoc(numchr, date, 16) call putlin(schr, fd); call putstr(date, 15, fd) junk = ditoc(numadr, date, 16) call putlin(sadr, fd); call putstr(date, 15, fd) junk = itoc(numfil, date, 16) call putlin(sfil, fd); call putstr(date, 15, fd) call putch('@n', fd) if (fd != ERROUT) call close(fd) for (i = 1; i <= 7; i = i + 1) start(i) = now(i) initdi(numchr) initdi(numadr) numfil = 0 return end #-h- inbclr 119 asc 16-mar-83 14:44:03 sventek (joseph sventek) #integer function inbclr(value, mask) # #integer value, mask #integer inbrtn # #return (inbrtn(value, mask, 'c')) #end #-h- inbrtn 1020 asc 16-mar-83 14:44:04 sventek (joseph sventek) ## routine inbrtn ## ## this routine will perform the appropriate bit manipulations of the ## second argument on the first, with the bit manipulation test indexed ## by the third argument. The result is returned as the value of the function. ## #integer function inbrtn(first, second, index) # #integer first, second #character index # #integer result, value, mask, bit, ifv, ifm, doit # #result = 0 #value = abs(first) #mask = abs(second) #for (bit = arith(2,**,arith(BITS_PER_WORD,-,2)); bit > 0; bit = bit / 2) # { # if (value >= bit) # { # ifv = YES # value = value - bit # } # else # ifv = NO # if (mask >= bit) # { # ifm = YES # mask = mask - bit # } # else # ifm = NO # doit = ifv # switch (index) # { # case 's': if (ifm == YES) # doit = YES # case 'c': if (ifm == YES) # doit = NO # case 't': if (doit == YES & ifm == NO) # doit = NO # } # if (doit == YES) # result = result + bit # } # #return(result) #end #-h- inbset 119 asc 16-mar-83 14:44:05 sventek (joseph sventek) #integer function inbset(value, mask) # #integer value, mask #integer inbrtn # #return (inbrtn(value, mask, 's')) #end #-h- inbtst 119 asc 16-mar-83 14:44:06 sventek (joseph sventek) #integer function inbtst(value, mask) # #integer value, mask #integer inbrtn # #return (inbrtn(value, mask, 't')) #end #-h- sndrcv 475 asc 13-may-83 16:18:12 sventek (joseph sventek) # function to send a packet over network and receive response integer function sndrcv(snd, put, rcv, get) character snd(ARB), rcv(ARB) integer stat integer put, get external put, get string sst "S: " string rst "R: " call errlog(sst, snd, L_BABBLE) if (put(snd) == ERR) stat = EOF else if (get(rcv) == EOF) stat = EOF else { call errlog(rst, rcv, L_BABBLE) if (rcv(1) != '2' & rcv(1) != '3') stat = ERR else stat = OK } return(stat) end #-h- sysdep.m 4052 asc 05-aug-83 17:17:15 sventek (joseph sventek) #-h- isaliv.mac 826 asc 30-mar-82 13:49:54 v1.1 (sw-tools v1.1) .title isaliv ;+ ; integer function isaliv(pname) ; ; return(YES/NO) ; ; this function determines if the process specified by `pname' is ; alive or not. It performs this by attempting a resume operation ; on the task, and returns YES if the status returned is ; IS.SUC or IE.ITS (task not suspended) ;- ap=%5 pname=2 .mcall rsum$,dir$ .psect $r.rwd,con,rw,rel,lcl,d dpb: rsum$ xxxxxx ; directive parameter block for RSUM .psect $r.roi,con,ro,rel,lcl,i .enabl lsb isaliv:: mov pname(ap),r0 ; address of taskname mov #dpb+r.sutn,r1 ; destination buffer call r$rad5 ; convert to rad50 mov #no,r0 ; assume not dir$ #dpb ; resume the task mov $dsw,r1 ; fetch status word bgt 20$ ; > 0 => success cmp r1,#ie.its ; task not suspended? bne 10$ ; NO 20$: mov #yes,r0 ; return(YES) 10$: return .end #-h- setpro.mac 1283 asc 06-jan-83 13:32:19 sventek (joseph sventek) .title setpro ;+ ; subroutine setpro(fd, prot) ; ; the file opened on `fd' has its protection mask set to the value ; contained in `prot'. The meaning of the bits in prot are: ; ; 1 1 1 1 | 1 1 Bit ; 5 4 3 2 | 1 0 9 8 | 7 6 5 4 | 3 2 1 0 Number ; ; d e w r | d e w r | d e w r | d e w r ; ; world group owner system ; ; If the corresponding bit is set, the particular privilege is ; ENABLED!!!!! ; The mask is complemented in a local storage cell before calling the ACP ;- .mcall qiow$s ap=%5 fd=2 prot=4 .psect $r.rwd,con,rw,rel,lcl,d pro: .word 0 .psect $r.roi,con,ro,rel,lcl,i .enabl lsb setpro:: mov @fd(ap),r0 ; ratfor unit number (lun) call r$gfbk ; get RFDB address into r1 bcs 10$ ; invalid file descriptor mov r.fdb(r1),r1 ; need FDB address mov @prot(ap),r0 ; fetch mask from caller com r0 ; set state of bits mov r0,pro ; place in local storage clr -(sp) ; build ACP control block on stack mov #pro,-(sp) ; address of protection word mov (pc)+,-(sp) ; function code for ACP .byte 2,2 ; write protection, 2 bytes mov sp,r3 ; address of control block movb f.lun(r1),r2 ; lun to use add #f.fnb+n.fid,r1 ; address of FID area qiow$s #io.wat,r2,r$ioef,,#r$iosb,, add #6,sp ; clean up stack 10$: return .end #-h- altpri.mac 372 asc 04-aug-82 16:35:56 sventek (joseph sventek) .title altpri ;+ ; subroutine altpri(pri) ; ; routine to alter the priority of the calling process ; the return status is ignored ; it should be noted that only privileged tasks can raise their ; priority above their installed values ;- ap=%5 pri=2 .mcall altp$s .psect $r.roi,con,ro,rel,lcl,i .enabl lsb altpri:: altp$s ,@pri(ap) ; alter our priority return .end #-h- setown.mac 1267 asc 06-jan-83 13:32:20 sventek (joseph sventek) .title setown ;+ ; subroutine setown(fd) ; ; the file opened on `fd' has its owning UIC set to the UIC in which ; it resides ;- .mcall qiow$s,alun$s ap=%5 fd=2 .psect $r.rwd,con,rw,rel,lcl,d uic: .word 0 ; space for UIC value .psect $r.roi,con,ro,rel,lcl,i .enabl lsb setown:: mov @fd(ap),r0 ; ratfor unit number (lun) call r$gfbk ; get RFDB address into r1 bcs 10$ ; c set => invalid file descriptor mov r.fdb(r1),r0 ; need FDB address clr -(sp) ; build ACP control block on stack mov #uic,-(sp) ; address of buffer for UIC mov (pc)+,-(sp) ; read UIC function code .byte -1,2 ; ... mov sp,r3 ; address of control block mov r0,r1 ; address of FDB add #f.fnb,r1 ; address of FNB mov r$endl,r2 ; use scratch lun alun$s r2,n.dvnm(r1),n.unit(r1) ; assign scratch lun to device bcs 20$ ; c set ==> error add #n.did,r1 ; address of DID qiow$s #io.rat,r2,r$ioef,,#r$iosb,, bcs 20$ ; c set => error tstb r$iosb ; check for error blt 20$ ; < 0 ==> error mov (pc)+,(sp) ; write UIC function code .byte 1,2 ; ... mov r0,r1 ; address of FDB add #f.fnb+n.fid,r1 ; address of FID movb f.lun(r0),r2 ; lun to use qiow$s #io.wat,r2,r$ioef,,#r$iosb,, 20$: add #6,sp ; clean up stack 10$: return .end #-h- sysdep.r 2878 asc 05-aug-83 17:17:18 sventek (joseph sventek) #-h- defns 16 asc 30-mar-82 13:56:49 v1.1 (sw-tools v1.1) include mailsym #-h- cre8mf 1490 asc 06-jan-83 13:38:35 sventek (joseph sventek) # the commented version immediately below has been replaced recently by # the bottom version # if any unexplained problems seem to be occurring, uncomment the top # version and comment out the bottom version #filedes function cre8mf(file, access) # #character file(ARB), scrbuf(arith(FILENAMESIZE,+,32)), pid(PIDSIZE) #filedes unit, fopen, create, fcreat #integer junk, spawn, access, i # #string s1 "pip " # the 32 above is sum of lengths #string s2 "/pr/sy:rwed/ow:rwed/gr/wo/fo" # of s1 and s2 #string local "local" # #if (fopen(file, READ, unit) == ERR) # file does not exist # { # if (fcreat(file, WRITE, unit) == ERR) # cannot create with default parameters # return(ERR) # call putch('@n', unit) # make it non-empty # call close(unit) # close the file # i = 1 # call stcopy(s1, 1, scrbuf, i) # make pip command line # call mklocl(file, scrbuf(i)) # ... # call concat(scrbuf, s2, scrbuf) # ... # junk = spawn(local, scrbuf, pid, WAIT)# spawn pip to set protection and owner # } #else # call close(unit) #return(create(file, access)) # #end filedes function cre8mf(file, access) character file(ARB) filedes unit, fopen, create, fcreat integer access if (fopen(file, READ, unit) == ERR) # file does not exist { if (fcreat(file, WRITE, unit) == ERR) # cannot create with default parameters return(ERR) call setpro(unit,8%377) # [rwed,rwed,,] call setown(unit) # set owner to UIC it resides in } call close(unit) return(create(file, access)) end #-h- gthost 138 asc 30-mar-82 14:46:07 v1.1 (sw-tools v1.1) subroutine gthost(netnam, host) character host(HOST_SIZE), netnam(ARB) string rest LOCAL_HOST_NAME call strcpy(rest, host) return end #-h- minit 168 asc 30-mar-82 13:56:53 v1.1 (sw-tools v1.1) subroutine minit(name) integer newast, oldast character name(ARB) call ttydet newast = 0 call srda(newast, oldast) #call close(STDIN) #call close(STDOUT) return end #-h- rcvmsg 228 asc 14-jan-83 13:37:34 sventek (joseph sventek) integer function rcvmsg(whofrm, msg) character whofrm(PIDSIZE), msg(26) character buf(30) integer i, j call rcvdat(, buf) for (i=5, j=1; i <= 30; i=i+1, j=j+1) msg(j) = buf(i) call sprint(whofrm, "%2r", buf) return(OK) end #-h- sndmsg 392 asc 30-mar-82 13:56:56 v1.1 (sw-tools v1.1) integer function sndmsg(whoto, msg) character whoto(ARB), msg(ARB) character buf(26), tpid(PIDSIZE) real task integer i integer sdat tpid(PIDSIZE) = EOS for (i=1; whoto(i) != EOS; i=i+1) tpid(i) = whoto(i) while (i < PIDSIZE) call chcopy(' ', tpid, i) call strcpy(msg, buf) call upper(tpid) call irad50(6, tpid, task) if (sdat(task, buf) != IS_SUC) return(ERR) else return(OK) end #-h- sysdepasm.sh 88 asc 05-aug-83 17:17:20 sventek (joseph sventek) ar xv sysdep.m | ch .mac | ch "%?*$" "mac &=&; lbr msg/rp=&" | sh -v ar t sysdep.m | rm #-h- tc.r 15442 asc 05-aug-83 17:17:23 sventek (joseph sventek) #-h- defns 262 asc 30-mar-82 13:57:01 v1.1 (sw-tools v1.1) define(TABLE,'t') define(PRINT,'p') define(MAX_ENTRIES,501) define(MAX_TOPICS,20) define(MAX_BUFFER,arith(MAX_TOPICS,*,20)) define(TC_ENV_FILE,"tc.env") define(DEF_PAGE_LEN,22) # default number of lines in page define(arskip,arcopy($1,ERR,$2)) include mailsym #-h- main 593 asc 09-jul-82 08:50:43 j (sventek j) DRIVER(tc) integer i, j, verbos integer docmd character topic(FILENAMESIZE), list(MAXLINE), com character user(MAX_TOK) include ctc include cpage string defalt "default" string pstr "@nContinue with next topic `&'? [n => NO] " call init(com, verbos) call mailid(user) call canonf(user) call gthost(defalt, list) call concat(user, list, user) call canonf(user) for (i=1; i <= ntopic; i=i+1) { j = topnam(i) call scopy(topbuf, j, topic, 1) j = toplst(i) call scopy(topbuf, j, list, 1) toplst(i) = docmd(com, topic, list, user, verbos) } call update(topic, list) DRETURN end #-h- arcopy 383 asc 30-mar-82 13:57:04 v1.1 (sw-tools v1.1) subroutine arcopy(fdi, fdo, size) filedes fdi, fdo integer size(2), hi, lo character c character getch hi = size(1) lo = size(2) if (lo == 0 & hi > 0) { lo = 10000 hi = hi - 1 } while (lo > 0) { if (getch(c, fdi) == EOF) break if (fdo != ERR) call putch(c, fdo) lo = lo - 1 if (lo == 0 & hi > 0) { lo = 10000 hi = hi - 1 } } return end #-h- docmd 1185 asc 30-mar-82 13:57:06 v1.1 (sw-tools v1.1) integer function docmd(com, topic, buf, user, verbos) character com, topic(ARB), buf(ARB), user(ARB) integer last, entry(MAX_ENTRIES), i, j, verbos integer tcexst, valusr, evalst, doprnt string msg0 "Topic does not exist: " string msg1 "Read access denied to '" string msg2 "' for topic: " string msg3 "Invalid list of entries for topic: " string msg4 "Entry list: " string msg5 "Bad char: " string prefix "@nTopic: " last = ERR i = 1 if (tcexst(topic) == NO) call errmsg(msg0, topic, '@n') else if (valusr(topic, user, READ) == NO) { call errmsg(msg1, user, EOS) call errmsg(msg2, topic, '@n') } else if (evalst(topic, buf, i, entry) == ERR) { call errmsg(msg3, topic, '@n') call errmsg(msg4, buf, '@n') call putlin(msg5, ERROUT) for (j=1; j < i; j=j+1) if (buf(i) != '@t') call putch(' ', ERROUT) else call putch('@t', ERROUT) call putch('^', ERROUT) call putch('@n', ERROUT) } else if (entry(1) != 0) # something to do { if (verbos == YES) { call putlin(prefix, STDOUT) call putlnl(topic, STDOUT) } if (com == TABLE) call dotabl(topic, entry) else last = doprnt(topic, entry) } return(last) end #-h- doprnt 1698 asc 22-oct-82 17:07:33 sventek (joseph sventek) integer function doprnt(topic, entry) character topic(ARB), name(FILENAMESIZE), cc character gtconf integer entry(ARB), stat, size(2), i, n, last integer gethdr, ctoi, intdex, getlin filedes fd, fdx filedes fopen linepointer addr include cfscr include cpage string suffix TC_SUFFIX string ndxsuf NDX_SUFFIX string msg1 "Cannot open file for teleconference topic: " string msg2 "Improper format for teleconference file - topic: " string msg3 "Cannot open index file for topic: " string pstr "@nDisplay next message? [n => NO] " string tpst "Display this topic? [n => NO] " last = ERR call gtcfil(topic, suffix, file) if (fopen(file, READ, fd) == ERR) call errmsg(msg1, topic, '@n') else { call gtcfil(topic, ndxsuf, file) if (fopen(file, READ, fdx) == ERR) call errmsg(msg3, file, '@n') else { while (getlin(scrbuf, fdx) != EOF) { i = 1 n = ctoi(scrbuf, i) if (intdex(entry, n) > 0) { call ctoptr(scrbuf, i, addr) call seek(addr, fd) if (gethdr(fd, scrbuf, name, size) == ERR) call errmsg(msg2, topic, '@n') else { if (last == ERR) if (ntops > 0) { cc = gtconf(tpst, pagefd) if (cc == 'n' | cc == EOF) break } else ntops = ntops + 1 else { cc = gtconf(pstr, pagefd) if (cc == 'n' | cc == EOF) break } last = n call putch('@n', STDOUT) call dspent(fd, scrbuf, topic, size) } } } call close(fdx) } call close(fd) } return(last) end #-h- dotabl 1068 asc 22-oct-82 17:07:35 sventek (joseph sventek) subroutine dotabl(topic, entry) character topic(ARB), name(FILENAMESIZE) integer entry(ARB), stat, size(2), i, n integer gethdr, ctoi, intdex, getlin filedes fd, fdx filedes fopen linepointer addr include cfscr string suffix TC_SUFFIX string ndxsuf NDX_SUFFIX string msg1 "Cannot open file for teleconference topic: " string msg2 "Improper format for teleconference file - topic: " string msg3 "Cannot open index file for topic: " call gtcfil(topic, suffix, file) if (fopen(file, READ, fd) == ERR) call errmsg(msg1, topic, '@n') else { call gtcfil(topic, ndxsuf, file) if (fopen(file, READ, fdx) == ERR) call errmsg(msg3, topic, '@n') else { while (getlin(scrbuf, fdx) != EOF) { i = 1 n = ctoi(scrbuf, i) if (intdex(entry, n) > 0) { call ctoptr(scrbuf, i, addr) call seek(addr, fd) if (gethdr(fd, scrbuf, name, size) == ERR) call errmsg(msg2, topic, '@n') else call dsphdr(scrbuf) } } call close(fdx) } call close(fd) } return end #-h- dspent 1207 asc 14-mar-83 22:37:53 sventek (joseph sventek) subroutine dspent(fd, buf, topic, size) filedes fd character buf(ARB), topic(ARB), key(KEY_SIZE) character gtconf integer size(2), incs(2), lines, inhead, doit integer getlin, hdrchk integer i include cpage string pstr "More? [n => NO] " string topstr "Topic: " string middle ", Entry # " initdi(incs) call gtckey(topic, key) call putlin(topstr, STDOUT) call putlin(topic, STDOUT) call putlin(middle, STDOUT) for (i = 6, call skipbl(buf, i); i <= 9; i = i + 1) call putch(buf(i), STDOUT) call putch('@n', STDOUT) lines = 2 inhead = YES doit = YES while (!(size(1) <= 0 & size(2) <= 0)) { incs(2) = getlin(buf, fd) if (incs(2) == EOF) break if (buf(1) == '@n') inhead = NO subdi(incs, size) if (lines >= pagesz) if (gtconf(pstr, pagefd) == 'n') { call arskip(fd, size) break } else lines = 0 call ncrypt(buf, key) if (inhead == YES) { if (buf(1) != ' ' & buf(1) != '@t') # see if header is valid doit = hdrchk(buf) #else # continuation lines inherit current value of doit } else doit = YES if (doit == YES) # display line { call putlin(buf, STDOUT) lines = lines + 1 } } return end #-h- dsphdr 159 asc 30-mar-82 13:57:12 v1.1 (sw-tools v1.1) subroutine dsphdr(buf) character buf(ARB) integer i integer index for (i=index(buf, ' ') + 1; buf(i) != EOS; i=i+1) call putch(buf(i), STDOUT) return end #-h- errmsg 169 asc 30-mar-82 13:57:13 v1.1 (sw-tools v1.1) subroutine errmsg(b1, b2, c) character b1(ARB), b2(ARB), c call putlin(b1, ERROUT) if (c == '@n') call putlnl(b2, ERROUT) else call putlin(b2, ERROUT) return end #-h- evalst 1073 asc 22-oct-82 17:07:37 sventek (joseph sventek) integer function evalst(topic, buf, i, entry) character topic(ARB), buf(ARB) integer entry(MAX_ENTRIES), minval, maxval, stat, i, j, first, last, k integer getlin, ctoi filedes fd filedes fopen include cfscr string suffix BND_SUFFIX entry(1) = 0 call gtcfil(topic, suffix, file) if (fopen(file, READ, fd) == ERR) return(ERR) stat = getlin(scrbuf, fd) call close(fd) if (stat == EOF) return(ERR) j = 1 minval = ctoi(scrbuf, j) maxval = ctoi(scrbuf, j) j = 1 stat = OK repeat { call skipbl(buf, i) if (!IS_DIGIT(buf(i))) { if (buf(i) != EOS) stat = ERR break } first = ctoi(buf, i) if (buf(i) != '-' & buf(i) != ':') last = first else { i = i + 1 # skip over '-' | ':' if (!IS_DIGIT(buf(i))) last = maxval else last = ctoi(buf, i) } for (k=first; k <= last; k=k+1) if (minval <= k & k <= maxval) if (j < MAX_ENTRIES) { entry(j) = k j = j + 1 } } if (stat == OK) { entry(j) = 0 call bubble(entry, j-1) call uniqit(entry) } return(stat) end #-h- gethdr 367 asc 30-mar-82 13:57:16 v1.1 (sw-tools v1.1) integer function gethdr(fd, buf, name, size) filedes fd character buf(MAXLINE), name(FILENAMESIZE) integer size(2), i, junk integer getlin, match1, length, getwrd string hdrstr "#-h- " if (getlin(buf, fd) == EOF) return(EOF) if (match1(buf, hdrstr) == NO) return(ERR) i = length(hdrstr) + 1 junk = getwrd(buf, i, name) call ctodi(buf, i, size) return(OK) end #-h- init 2706 asc 14-mar-83 22:37:55 sventek (joseph sventek) subroutine init(comand, verbos) # initialize all the stuff character comand, buf(MAXLINE), file(FILENAMESIZE), topic(FILENAMESIZE), entry(FILENAMESIZE) character clower integer i, junk, last, found, j, verbos integer getarg, index, getlin, getwrd, ctoi, itoc, length, equal, isatty filedes fd filedes open, fopen include ctc include cfiltr include cpage string usestr "usage: tc [-] {p|t}[v] [topic] [entry] ..." string valcom "pt" string tcfil TC_ENV_FILE string onedsh "1-" string genral "general" string all "all" string ttyfil TERMINAL_IN call query(usestr) if (isatty(STDOUT) == YES) { pagefd = open(ttyfil, READ) pagesz = DEF_PAGE_LEN } else { pagefd = ERR pagesz = HUGE } ntops = 0 # no topics displayed yet verbos = NO filter = YES # default to stripping garbage headers for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1) if (buf(1) == '-') # changing page size { j = 2 pagesz = ctoi(buf, j) if (pagesz <= 0) # turns off paging { if (pagefd != ERR) call close(pagefd) pagefd = ERR } call delarg(i) i = i - 1 } if (getarg(1, buf, MAXLINE) == EOF) call error(usestr) comand = clower(buf(1)) if (buf(2) == 'v' | buf(2) == 'V') # don't strip garbage headers { filter = NO j = 3 } else j = 2 if (index(valcom, comand) == 0 | buf(j) != EOS) call error(usestr) ntopic = 0 lstbuf = 0 call homdir(file, LOCAL) call concat(file, tcfil, file) if (getarg(2, topic, FILENAMESIZE) == EOF) call strcpy(genral, topic) else if (IS_DIGIT(topic(1))) call strcpy(genral, topic) else call delarg(2) call fold(topic) if (equal(topic, all) == YES) { if (fopen(file, READ, fd) == ERR) call cant(file) while (getlin(buf, fd) != EOF) { i = 1 junk = getwrd(buf, i, topic) call fold(topic) last = ctoi(buf, i) + 1 i = itoc(last, buf, MAXLINE) + 1 call chcopy('-', buf, i) call packit(topic, buf) } call close(fd) verbos = YES } else if (getarg(2, buf, MAXLINE) == EOF) # entries not specified { found = NO if (fopen(file, READ, fd) != ERR) { while (getlin(buf, fd) != EOF) { i = 1 junk = getwrd(buf, i, entry) last = ctoi(buf, i) + 1 if (equal(topic, entry) == YES) { found = YES i = itoc(last, buf, MAXLINE) + 1 call chcopy('-', buf, i) break } } call close(fd) } if (found == NO) call strcpy(onedsh, buf) call packit(topic, buf) } else { j = length(buf) + 1 for (i=3; getarg(i, entry, FILENAMESIZE) != EOF; i=i+1) { call chcopy(' ', buf, j) call stcopy(entry, 1, buf, j) } call packit(topic, buf) } return end #-h- intdex 147 asc 30-mar-82 13:57:21 v1.1 (sw-tools v1.1) integer function intdex(iarray, n) integer iarray(ARB), n, i for (i=1; iarray(i) != 0; i=i+1) if (iarray(i) == n) return(i) return(0) end #-h- packit 541 asc 16-jun-83 13:53:49 sventek (joseph sventek) subroutine packit(topic, buf) character topic(ARB), buf(ARB) integer last integer length include ctc #call putlin(topic, ERROUT); call putch(' ', ERROUT); call remark(buf) if (ntopic >= MAX_TOPICS) call error("Too many topics") ntopic = ntopic + 1 last = lstbuf + length(topic) + length(buf) + 2 if (last > MAX_BUFFER) call error("Character storage exceeded") lstbuf = lstbuf + 1 topnam(ntopic) = lstbuf call stcopy(topic, 1, topbuf, lstbuf) lstbuf = lstbuf + 1 toplst(ntopic) = lstbuf call stcopy(buf, 1, topbuf, lstbuf) return end #-h- scan 310 asc 30-mar-82 13:57:24 v1.1 (sw-tools v1.1) integer function scan(topic, ndx) character topic(ARB), temp(FILENAMESIZE) integer ndx, i integer equal include ctc for (ndx=1; ndx <= ntopic; ndx = ndx + 1) { i = topnam(ndx) call scopy(topbuf, i, temp, 1) if (equal(topic, temp) == YES) break } if (ndx > ntopic) ndx = ERR return(ndx) end #-h- uniqit 230 asc 30-mar-82 13:57:25 v1.1 (sw-tools v1.1) subroutine uniqit(entry) integer entry(ARB), i, j, value i = 1 j = 1 while (entry(j) != 0) { value = entry(j) entry(i) = value i = i + 1 for (j = j + 1; entry(j) == value; j = j + 1) ; } entry(i) = 0 return end #-h- update 1303 asc 16-jun-83 13:53:51 sventek (joseph sventek) subroutine update(file, buf) character file(ARB), buf(ARB), scrat(FILENAMESIZE), topic(FILENAMESIZE) integer i, junk, last, ndx integer getlin, getwrd, ctoi, scan, amove filedes fo, fi filedes fcreat, fopen include ctc string tce "tce" string tcenv TC_ENV_FILE for (i=1; i <= ntopic; i=i+1) if (toplst(i) != ERR) break if (i > ntopic) return call scratf(tce, scrat) if (fcreat(scrat, WRITE, fo) == ERR) call error("Cannot create temp file for updating tc.env") call homdir(file, LOCAL) call concat(file, tcenv, file) if (fopen(file, READ, fi) != ERR) { while (getlin(buf, fi) != EOF) { i = 1 junk = getwrd(buf, i, topic) call fold(topic) last = ctoi(buf, i) if (scan(topic, ndx) != ERR) { if (toplst(ndx) > last) last = toplst(ndx) toplst(ndx) = ERR } call putlin(topic, fo) call putch(' ', fo) call putint(last, 1, fo) call putch('@n', fo) } call close(fi) } for (ndx=1; ndx <= ntopic; ndx=ndx+1) if (toplst(ndx) != ERR) { i = topnam(ndx) call scopy(topbuf, i, topic, 1) call putlin(topic, fo) call putch(' ', fo) call putint(toplst(ndx), 1, fo) call putch('@n', fo) } call close(fo) if (amove(scrat, file) == ERR) call error("Error updating tc.env file") return end #-h- hdrchk 702 asc 14-mar-83 22:47:16 sventek (joseph sventek) integer function hdrchk(buf) character buf(ARB) integer result integer match1 include cfiltr string rcvd "Received:" string xtra "X-ST-" string path "Return-Path:" string from "Mail-From:" string via "Via:" string mail "Remailed-" string sent "Resent-" result = YES # assume line OK if (filter == YES) { if (match1(buf, rcvd) == YES) result = NO else if (match1(buf, xtra) == YES) result = NO else if (match1(buf, path) == YES) result = NO else if (match1(buf, from) == YES) result = NO else if (match1(buf, via) == YES) result = NO else if (match1(buf, mail) == YES) result = NO else if (match1(buf, sent) == YES) result = NO } return(result) end #-h- tcadd.r 7849 asc 05-aug-83 17:17:32 sventek (joseph sventek) #-h- defns 123 asc 30-mar-82 13:57:40 v1.1 (sw-tools v1.1) define(NAM_WIDTH,4) define(SIZ_WIDTH,6) define(DAT_WIDTH,13) define(FRM_WIDTH,20) define(RIGHT_MARGIN,80) include mailsym #-h- main 1296 asc 16-jun-83 13:55:45 sventek (joseph sventek) DRIVER(tcadd) character buf(MAXLINE), topic(FILENAMESIZE), from(MAXLINE), date(MAXLINE), subj(MAXLINE) integer i, j, doguru integer getarg, index, tcexst, valusr, nxthdr, length string genral "general" string invtop "Non-existent topic: " string usrnam "User attempting to add entry: " string invusr "Unauthorized user: " string topnam "Attempt to add to topic: " string reqest "-request" if (getarg(1, buf, MAXLINE) == EOF) call error("usage: tcadd tc[_topic] 0 & imatch(buf, j, reqest) == YES) { doguru = YES buf(j) = EOS } else doguru = NO if (i == 0) call strcpy(genral, topic) else call scopy(buf, i+1, topic, 1) if (nxthdr(buf, STDIN) == EOF) call error("Empty input file") if (doguru == YES) call sdguru(topic, buf) # send to topic guru else { call scnmsg(STDIN, from, date, subj, buf, NO) call canonf(from) call canond(date) if (tcexst(topic) == NO) { call logmsg(invtop, topic, ERROUT) call logmsg(usrnam, from, ERROUT) call endst(ERR) } if (valusr(topic, from, WRITE) == NO) { call logmsg(invusr, from, ERROUT) call logmsg(topnam, topic, ERROUT) call endst(ERR) } call addent(topic, from, date, subj, buf) } DRETURN end #-h- addent 2048 asc 16-jun-83 13:55:47 sventek (joseph sventek) subroutine addent(topic, from, date, subj, buf) character topic(ARB), from(ARB), date(ARB), subj(ARB), buf(MAXLINE) character scrat(FILENAMESIZE), file(FILENAMESIZE), temp(MAXCHARS), key(KEY_SIZE) filedes fo, fi, fa filedes fcreat, fopen integer size(2), incs(2), junk, i, first, last integer getlin, ctoi, ditoc, remove, note linepointer addr string tca "tca" string bndsuf BND_SUFFIX string bnderr "Cannot access bounds file: " string tcsuf TC_SUFFIX string tcerr "Cannot access teleconference file: " string hdrstr "#-h- " call close(STDOUT) # save an I/O unit call scratf(tca, scrat) if (fcreat(scrat, WRITE, fo) == ERR) call error("Cannot create scratch file") initdi(size) initdi(incs) call gtckey(topic, key) for (incs(2)=getlin(buf, STDIN); incs(2) != EOF; incs(2)=getlin(buf, STDIN)) { call ncrypt(buf, key) call putlin(buf, fo) adddi(incs, size) } call close(fo) if (fopen(scrat, READ, fi) == ERR) call error("Cannot re-open scratch file") call gtcfil(topic, bndsuf, file) if (fcreat(file, READWRITE, fo) == ERR) { call close(fi) call logmsg(bnderr, file, ERROUT) call endst(ERR) } junk = note(addr, fo) if (getlin(buf, fo) == EOF) { last = 1 first = 1 } else { i = 1 first = ctoi(buf, i) last = ctoi(buf, i) + 1 } call gtcfil(topic, tcsuf, file) if (fcreat(file, APPEND, fa) == ERR) { call close(fo) call close(fi) call logmsg(tcerr, file, ERROUT) call endst(ERR) } call putlin(hdrstr, fa) call putint(last, NAM_WIDTH, fa) junk = ditoc(size, temp, MAXCHARS) call putstr(temp, SIZ_WIDTH, fa) call putch(' ', fa) date(DAT_WIDTH) = EOS call putstr(date, -DAT_WIDTH, fa) from(FRM_WIDTH) = EOS call putstr(from, -FRM_WIDTH, fa) i = RIGHT_MARGIN - NAM_WIDTH - SIZ_WIDTH - FRM_WIDTH - DAT_WIDTH - 1 subj(i) = EOS call putlnl(subj, fa) call fcopy(fi, fa) call close(fa) call close(fi) call seek(addr, fo) call putint(first, 1, fo) call putch(' ', fo) call putint(last, 1, fo) call putch('@n', fo) call close(fo) junk = remove(scrat) call updndx(topic, file, scrat, buf) return end #-h- updndx 1674 asc 06-dec-82 14:08:41 sventek (joseph sventek) subroutine updndx(topic, tc, ndx, buf) character topic(ARB), tc(FILENAMESIZE), ndx(FILENAMESIZE), buf(MAXLINE) filedes ifd, ofd filedes fopen, fcreat integer junk, size(2), fsize(2), i integer note, agethd, getlin, ctoi, ptreq linepointer addr string tcsuf TC_SUFFIX string ndxsuf NDX_SUFFIX string tcerr "Error opening .tc file to update index for topic: " string ndxerr "Error creating .ndx file to update for topic: " string corupt "Teleconference file is corrupt for topic: " call gtcfil(topic, tcsuf, tc) call gtcfil(topic, ndxsuf, ndx) if (fopen(tc, READ, ifd) == ERR) call logmsg(tcerr, topic, ERROUT) else if (fcreat(ndx, READWRITE, ofd) == ERR) { call close(ifd) call logmsg(ndxerr, topic, ERROUT) } else { call ptrcpy(NULLPOINTER, addr) # assume index is empty while (getlin(buf, ofd) != EOF) # do until end { i = 1 junk = ctoi(buf, i) # skip past entry number call ctoptr(buf, i, addr) # generate address in .tc file } fsize(1) = MAX_INTEGER fsize(2) = 0 if (ptreq(addr, NULLPOINTER) == NO) # index was NOT empty { call seek(addr, ifd) # seek to last noted entry if (agethd(ifd, buf, size, fsize) != OK) { call close(ifd) call close(ofd) call logmsg(corupt, topic, ERROUT) return } call askip(ifd, size, fsize) # skip over entry } junk = note(addr, ifd) if (agethd(ifd, buf, size, fsize) != OK) { call close(ifd) call close(ofd) call logmsg(corupt, topic, ERROUT) return } call putlin(buf, ofd) call putch(' ', ofd) call putptr(addr, ofd) call putch('@n', ofd) call close(ifd) call close(ofd) } return end #-h- gtguru 733 asc 06-dec-82 19:04:01 sventek (joseph sventek) # get the address of the topic guru into buf. Return Postmaster if none # found subroutine gtguru(topic, guru, buf) character topic(ARB), buf(MAXLINE), file(FILENAMESIZE), guru(MAX_TOK) integer found, n, junk integer getlin, equal, adrpth filedes fd filedes fopen string nfosuf NFO_SUFFIX string gurust ":guru@n" string pmastr "Postmaster" found = NO call gtcfil(topic, nfosuf, file) if (fopen(file, READ, fd) != ERR) { while (getlin(buf, fd) != EOF) if (buf(1) == ':') if (equal(buf, gurust) == YES) { n = getlin(buf, fd) buf(n) = EOS junk = adrpth(buf, guru) found = YES break } call close(fd) } if (found == NO) call strcpy(pmastr, guru) return end #-h- sdguru 1517 asc 16-jun-83 13:55:50 sventek (joseph sventek) subroutine sdguru(topic, buf) character topic(ARB), buf(MAXLINE), guru(MAX_TOK) integer junk, i, eofhdr integer getlin, remove, index, sndmlr, savmsg filedes fd filedes fcreat string tmpfil "~tmp/guru.msg" string mailfr MAIL_FROM_STR string rcptto RCPT_TO_STR string datast DATA_STR string savfil "~msg/dead.tca" string pname "tcadd" string defalt "default" string sentfr "Resent-from: Tcadd" string sentto "Resent-to: " string sentdt "Resent-date: " if (fcreat(tmpfil, WRITE, fd) == ERR) # failed to create scratch file call error("Error creating scratch for sending message to topic guru") if (getlin(buf, STDIN) == EOF) # bad message { call close(fd) junk = remove(tmpfil) call error("Bad input file") } i = index(buf, '<') call scopy(buf, i, buf, 1) # collapse Return-path line call logmsg(mailfr, buf, fd) # have MAIL FROM:<...> call gtguru(topic, guru, buf) # get guru's name from nfo file call angbrk(rcptto, guru, fd) # have RCPT TO:<...> call putlnl(datast, fd) # have DATA eofhdr = NO while (getlin(buf, STDIN) != EOF) if (buf(1) == '@n' & eofhdr == NO) { eofhdr = YES call gthost(defalt, buf) call logmsg(sentfr, buf, fd) call angbrk(sentto, guru, fd) call putlin(sentdt, fd) call ptdate(fd) call putch('@n', fd) } else call putlin(buf, fd) call close(fd) call minit(pname) if (sndmlr(tmpfil) != OK) if (savmsg(tmpfil, savfil) == ERR) call error("Cannot contact mailer OR queue message for mretry") junk = remove(tmpfil) return end #-h- tcarch.r 9651 asc 05-aug-83 17:17:38 sventek (joseph sventek) #-h- defns 133 asc 06-jul-83 15:12:41 sventek (joseph sventek) include mailsym define(FILE_WIDTH,-15) define(DATE_WIDTH,-10) define(TIME_WIDTH,-10) define(USER_WIDTH,-25) define(MAX_ENTRIES,251) #-h- main 965 asc 05-aug-83 10:06:36 sventek (joseph sventek) DRIVER(tcarch) integer i integer isaliv, getarg, tcexst, valusr character buf(MAXLINE), ntrlst(MAXLINE), topic(FILENAMESIZE), user(MAX_TOK) string usestr "usage: tcarch topic entry ..." call query(usestr) if (isaliv("mailer") == YES) call error("Mail system must be stopped before invoking tcarch!") ntrlst(1) = EOS for (i = 1; getarg(i, buf, MAXLINE) != EOF; i = i + 1) switch(i) { case 1: call strcpy(buf, topic) # save topic name default:call apntry(buf, ntrlst) # another entry } call fold(topic) if (i < 3) # too few arguments call error(usestr) else if (tcexst(topic) == NO) { call logmsg("Invalid topic: ", topic, ERROUT) call endst(ERR) } call mailid(user) call gthost("default", buf) call concat(user, buf, user) call canonf(user) if (valusr(topic, user, WRITE) == NO) { call logmsg("Unauthorized user: ", user, ERROUT) call endst(ERR) } call archiv(topic, user, ntrlst, buf) DRETURN end #-h- apntry 724 asc 06-jul-83 15:12:44 sventek (joseph sventek) # analyzes the entry passed as a character string in buf. # if valid, appends to the character array list subroutine apntry(buf, list) integer i, junk integer ctoi, length string ivntry "Invalid entry: " character buf(ARB), list(ARB) i = 1 if (!IS_DIGIT(buf(i))) { call logmsg(ivntry, buf, ERROUT) call endst(ERR) } junk = ctoi(buf, i) if (buf(i) == '-' | buf(i) == ':') { i = i + 1 if (!IS_DIGIT(buf(i)) & buf(i) != EOS) { call logmsg(ivntry, buf, ERROUT) call endst(ERR) } junk = ctoi(buf, i) } if (buf(i) != EOS) { call logmsg(ivntry, buf, ERROUT) call endst(ERR) } i = length(list) + 1 call chcopy(' ', list, i) call stcopy(buf, 1, list, i) return end #-h- archiv 2846 asc 06-jul-83 16:04:56 sventek (joseph sventek) # subroutine to archive the requested entries subroutine archiv(topic, user, list, buf) character topic(ARB), user(ARB), list(ARB), buf(MAXLINE) character suffix(10), root(FILENAMESIZE), afile(FILENAMESIZE), tfile(FILENAMESIZE), file(FILENAMESIZE), key(KEY_SIZE), name(MAXCHARS) integer entry(MAX_ENTRIES), i, first, last, size(2), incs(2), ntry, found integer evalst, gethdr, ctoi, intdex, getlin, equal filedes afd, tfd, ifd, ofd filedes fcreat, fopen if (evalst(topic, list, entry) == ERR) # generate list of entries to archive call error("Error in entry list!") call gtseqn(topic, suffix, buf) # get next archive file suffix i = 1 call restop(topic, root, i) # determine file root call concat(root, suffix, afile) # generate archive name call logmsg("Name of archive file: ", afile, ERROUT) if (fcreat(afile, WRITE, afd) == ERR) # create archive file call error("Cannot create archive file in current directory!") call concat(root, TC_SUFFIX, tfile) # updated .tc file if (fcreat(tfile, WRITE, tfd) == ERR) # create .tc file call error("Cannot create .tc file in current directory!") call gtcfil(topic, TC_SUFFIX, file) # name of .tc file if (fopen(file, READ, ifd) == ERR) call error("Cannot open .tc file in TC directory!") call gtckey(topic, key) first = HUGE last = 0 while (gethdr(ifd, buf, name, size) != EOF) { i = 1 ntry = ctoi(name, i) if (intdex(entry, ntry) > 0) # one to archive ofd = afd else { ofd = tfd first = min(first, ntry) last = max(last, ntry) } call putlin(buf, ofd) # output header line initdi(incs) while (!(size(1) <= 0 & size(2) <= 0)) { incs(2) = getlin(buf, ifd) if (incs(2) == EOF) break subdi(incs, size) if (ofd == afd) call ncrypt(buf, key) call putlin(buf, ofd) } } call close(ofd) call close(tfd) call close(ifd) call concat(root, BND_SUFFIX, file) if (fcreat(file, WRITE, ofd) == ERR) call error("Error creating updated bounds file!") call putint(first, 1, ofd) call putch(' ', ofd) call putint(last, 1, ofd) call putch('@n', ofd) call close(ofd) call gtcfil(topic, NFO_SUFFIX, file) if (fopen(file, READ, ifd) == ERR) call error("Error opening .nfo file!") call concat(root, NFO_SUFFIX, tfile) if (fcreat(tfile, WRITE, ofd) == ERR) call error("Error creating updated .nfo file!") found = NO while (getlin(buf, ifd) != EOF) { call putlin(buf, ofd) if (equal(buf, ":archive@n") == YES) # insert archive information { found = YES call audit(afile, user, list, ofd) # insert audit trail } } call close(ifd) if (found == NO) { call putlin(":archive@n", ofd) call audit(afile, user, list, ofd) } call close(ofd) call audit(afile, user, list, ERROUT) call remind(topic, root, buf) return end #-h- audit 459 asc 06-jul-83 15:12:47 sventek (joseph sventek) # format audit trail line for archiving of teleconference entries # # filename date user entries subroutine audit(file, user, list, fd) character file(ARB), user(ARB), list(ARB), date(10), time(10) integer now(7) filedes fd call getnow(now) call fmtdat(date, time, now, LETTER) call putstr(file, FILE_WIDTH, fd) call putstr(date, DATE_WIDTH, fd) call putstr(time, TIME_WIDTH, fd) call putstr(user, USER_WIDTH, fd) call putlnl(list, fd) return end #-h- evalst 1076 asc 06-jul-83 15:12:49 sventek (joseph sventek) integer function evalst(topic, buf, entry) character topic(ARB), buf(ARB) integer entry(MAX_ENTRIES), minval, maxval, stat, i, j, first, last, k integer getlin, ctoi filedes fd filedes fopen include cfscr string suffix BND_SUFFIX entry(1) = 0 call gtcfil(topic, suffix, file) if (fopen(file, READ, fd) == ERR) return(ERR) stat = getlin(scrbuf, fd) call close(fd) if (stat == EOF) return(ERR) j = 1 minval = ctoi(scrbuf, j) maxval = ctoi(scrbuf, j) j = 1 stat = OK i = 1 repeat { call skipbl(buf, i) if (!IS_DIGIT(buf(i))) { if (buf(i) != EOS) stat = ERR break } first = ctoi(buf, i) if (buf(i) != '-' & buf(i) != ':') last = first else { i = i + 1 # skip over '-' | ':' if (!IS_DIGIT(buf(i))) last = maxval else last = ctoi(buf, i) } for (k=first; k <= last; k=k+1) if (minval <= k & k <= maxval) if (j < MAX_ENTRIES) { entry(j) = k j = j + 1 } } if (stat == OK) { entry(j) = 0 call bubble(entry, j-1) call uniqit(entry) } return(stat) end #-h- gethdr 367 asc 06-jul-83 15:12:50 sventek (joseph sventek) integer function gethdr(fd, buf, name, size) filedes fd character buf(MAXLINE), name(FILENAMESIZE) integer size(2), i, junk integer getlin, match1, length, getwrd string hdrstr "#-h- " if (getlin(buf, fd) == EOF) return(EOF) if (match1(buf, hdrstr) == NO) return(ERR) i = length(hdrstr) + 1 junk = getwrd(buf, i, name) call ctodi(buf, i, size) return(OK) end #-h- remind 581 asc 06-jul-83 15:12:51 sventek (joseph sventek) define(Rename,call putlin("mv ", ERROUT) call concat(root, $1, buf) call putlin(buf, ERROUT) call gtcfil(topic, $1, buf) call putch(' ', ERROUT) call putlnl(buf, ERROUT) ) subroutine remind(topic, root, buf) character topic(ARB), root(ARB), buf(ARB) call putlin("Execute the following commands to complete the process:@n@n", ERROUT) Rename(TC_SUFFIX) Rename(NFO_SUFFIX) Rename(BND_SUFFIX) call putlin("asam <", ERROUT) call gtcfil(topic, TC_SUFFIX, buf) call putlin(buf, ERROUT) call putlin(" >", ERROUT) call gtcfil(topic, NDX_SUFFIX, buf) call putlnl(buf, ERROUT) return end #-h- uniqit 230 asc 06-jul-83 15:12:52 sventek (joseph sventek) subroutine uniqit(entry) integer entry(ARB), i, j, value i = 1 j = 1 while (entry(j) != 0) { value = entry(j) entry(i) = value i = i + 1 for (j = j + 1; entry(j) == value; j = j + 1) ; } entry(i) = 0 return end #-h- intdex 147 asc 06-jul-83 15:12:53 sventek (joseph sventek) integer function intdex(iarray, n) integer iarray(ARB), n, i for (i=1; iarray(i) != 0; i=i+1) if (iarray(i) == n) return(i) return(0) end #-h- gtseqn 1276 asc 06-jul-83 15:51:45 sventek (joseph sventek) # subroutine to determine the next suffix for a backup file # scans the .nfo file for the last suffix string - increments (base 36) # and returns as a suffix (.000 for example) subroutine gtseqn(topic, suffix, buf) integer i, junk, digit1, digit2, digit3 integer getlin, equal, index, getwrd filedes fd filedes fopen character file(FILENAMESIZE), topic(ARB), suffix(ARB), buf(ARB) string digits "0123456789abcdefghijklmnopqrstuvwxyz" call gtcfil(topic, NFO_SUFFIX, file) if (fopen(file, READ, fd) == ERR) call error("Error opening .nfo file for topic!") call strcpy(".000", suffix) while (getlin(buf, fd) != EOF) if (buf(1) == ':') if (equal(buf, ":archive@n") == YES) { if (getlin(buf, fd) != EOF) { i = index(buf, '.') junk = getwrd(buf, i, suffix) } break } call close(fd) digit3 = index(digits, suffix(4)) digit2 = index(digits, suffix(3)) digit1 = index(digits, suffix(2)) digit3 = digit3 + 1 if (digit3 > 36) { digit3 = 1 digit2 = digit2 + 1 if (digit2 > 36) { digit2 = 1 digit1 = digit1 + 1 if (digit1 > 36) digit1 = 1 } } suffix(4) = digits(digit3) suffix(3) = digits(digit2) suffix(2) = digits(digit1) return end #-h- ttynot.mac 6031 asc 05-aug-83 17:17:42 sventek (joseph sventek) v4=0 ; comment out this line if you are not running RSX v4.0 .title ttynot - program to broadcast messages to logged in users .enabl lc ;+ ; this program, when installed at TTYNOT, permits a message to ; be broadcast to all logged in users with particular UIC's. ; ; To use TTYNOT, a program should perform the following steps: ; ; 1. create a variable length record file with two records: ; ; a. The completely formatted message (including 's and ; 's) should be the first record ; ; b. The binary UIC's as words, terminated with a word of 0 ; ; 2. Send a message (via SDAT$) with the 0-byte terminated name ; of the file containing these records. ; ; 3. Request that TTYNOT be run ; ; Upon being requested, TTYNOT receives data packets, and for each ; packet, opens the file and fetches the two records, afterwards ; deleting the file. It then switches to system state, noting the ; owner UIC and unit number of all logged in TTn:'s. Returning ; to user state, this list is scanned for the UIC's in the 2nd record. ; When one is found, a lun is assigned to it and the message is ; displayed on the terminal with a break-through write. ;- .dsabl lc .mcall rcvx$,alun$s,qiow$s,dir$ .mcall fdbdf$,fdat$a,fdop$a,fsrsz$,ofnb$,get$,delet$ .mcall swstk$ .page .sbttl data - data areas for MSGNOT fdb: fdbdf$ ; File descriptor block fdat$a r.var,fd.cr ; variable length records, list carriage ctrl fdop$a 1 ; use lun 1 fsrsz$ 1 ; one open file fdsc: .blkw 6 ; data set descriptor tmp: .blkb 30. ; buffer for file spec rcvxdb: rcvx$ ,rcvbuf ; DPB for receive data or exit rcvbuf: ; 30 byte buffer for received messages sndtsk: .blkw 2 ; sender's task name (ignored) buf: .blkw 13. ; received buffer of UIC's .word 0 ; assure 0 byte for from string nucbs: .blkw 1 ; number of logged in TT's uiclst: .blkw 64. ; space for UIC's of logged in TT's untlst: .blkw 64. ; space for unit number of TT's msg: .blkb 256. ; buffer for message msgl=.-msg msglen: .blkw 1 ; location to receive size of message uic: .blkw 128. ; buffer for binary UIC's uicl=.-uic .even .page .sbttl code - code for MSGNOT .enabl lsb start: dir$ #rcvxdb ; receive data or exit mov #tmp,r0 ; destination buffer mov #buf,r1 ; source buffer call scopy ; copy buffer mov #tmp,r0 ; address of file spec mov #fdsc,r1 ; address of data set descriptor clr (r1) ; zero length fields in dspt clr 4(r1) ; ... clr 10(r1) ; ... mov r0,r3 ; initialize roving pointer mov r3,r2 ; start of string 10$: cmpb (r3),#': ; end of device string? bne 20$ ; NO mov r2,2(r1) ; store starting address mov r3,r0 ; calculate length sub r2,r0 ; ... inc r0 ; ... mov r0,(r1) ; place length in dspt mov r3,r2 ; new start of string inc r2 ; ... br 30$ ; do next field 20$: cmpb (r3),#'] ; end of UIC string? bne 25$ ; NO mov r2,6(r1) ; store starting address mov r3,r0 ; calculate length sub r2,r0 ; ... inc r0 ; ... mov r0,4(r1) ; store length mov r3,r2 ; new start of string inc r2 ; ... br 30$ ; do next field 25$: tstb 1(r3) ; end of file spec? bne 30$ ; NO mov r2,12(r1) ; store address mov r3,r0 ; calculate length sub r2,r0 ; ... inc r0 ; ... mov r0,10(r1) ; store length 30$: .enabl lc movb (r3),r0 ; get character cmp r0,#'a ; lower case? blt 40$ ; NO cmp r0,#'z ; lower case? bgt 40$ ; NO bic #40,r0 ; make upper case .dsabl lc 40$: movb r0,(r3)+ ; copy character back into string tstb (r3) ; end of file spec? bne 10$ ; NO mov #fdb,r0 ; address of FDB mov #fdb+f.fnb,r1 ; address of name block mov #fdsc,r2 ; data set descriptor clr r3 ; no default name block call .parse ; parse file spec bcs start ; error, try next packet ofnb$ #fdb,#fo.rd ; open file at read access bcs start ; error, try next packet get$ #fdb,#msg,#msgl ; get message to broadcast mov f.nrbd(r0),msglen ; save length of message get$ #fdb,#uic,#uicl ; get list of UIC's delet$ #fdb ; close and delete file .enabl lsb 10$: clr nucbs ; no logged in UCB's initially swstk$ 50$ ; switch to system state mov #uiclst,r0 ;# address of uic list mov #untlst,r1 ;# address of unit list mov #$devhd,r2 ;# address of device listhead 20$: ;# top of device loop mov (r2),r2 ;# next DCB address beq 45$ ;# if 0, done cmp #"TT,d.nam(r2) ;# is this a terminal? bne 20$ ;# NO, try next device mov d.ucb(r2),r3 ;# address of first UCB movb d.unit(r2),r4 ;# low unit number of device movb d.unit+1(r2),r5 ;# high unit number of device 30$: ;# top of unit loop bit #u2.log,u.cw2(r3) ;# is this terminal logged on? bne 40$ ;# NO .if df v4 bit #f3.cli,$fmask+4 ;# multi-CLI support? beq 35$ ;# NO, so broadcasts not disabled bit #um.nbr,u.mup(r3) ;# no broadcast bit set bne 40$ ;# YES, do not notify .endc 35$: mov u.luic(r3),(r0)+ ;# save this UIC mov r4,(r1)+ ;# and unit number inc nucbs ;# update count of logged in terms 40$: ;# add d.ucbl(r2),r3 ;# address of next UCB inc r4 ;# update current unit number cmp r4,r5 ;# end of UCB list? ble 30$ ;# NO, try next one br 20$ ;# try next device 45$: ;# reference label return ;# return to user state 50$: ; reference label tst nucbs ; any logged on terminals beq 90$ ; NO, try next message mov #uic,r0 ; address of received buffer 60$: mov (r0)+,r1 ; next UIC to scan for beq 90$ ; if 0, done mov nucbs,r2 ; number of UCB's to test against mov #uiclst,r3 ; address of list of UIC's mov #untlst,r4 ; list of unit numbers 70$: cmp r1,(r3)+ ; this tty? bne 80$ ; NO alun$s #1,#"TT,(r4) ; assign lun 1 to terminal bcs 80$ ; c set => error qiow$s #io.wbt,#1,#1,,,,<#msg,msglen,#0> ; notify user 80$: tst (r4)+ ; bump to next unit sob r2,70$ ; try next UCB br 60$ ; try next UIC 90$: jmp start ; get next message ; ; ; scopy: movb (r1)+,(r0)+ ; copy character bne scopy ; not EOS yet tstb -(r0) ; went one too far return .end start #-h- ttynotasm.cmd 116 asc 05-aug-83 17:17:45 sventek (joseph sventek) .ENABLE SUBSTITUTION PIP TTYNOT.OBJ;*/DE/NM,TTYNOT.LST;* MAC TTYNOT=LB:[1,1]EXEMC/ML,[11,10]RSXMC,SY:''TTYNOT #-h- ttynotbld.cmd 287 asc 05-aug-83 17:17:46 sventek (joseph sventek) .ENABLE SUBSTITUTION PIP TTYNOT.TSK;*/DE/NM .OPEN TTYNOT.TKB .DATA TTYNOT/-FP/CP/PR=TTYNOT .DATA LB:[1,54]RSX11M.STB/SS .DATA LB:[1,1]EXELIB/LB .DATA / .DATA UNITS=1 .DATA STACK=64 .DATA TASK=TTYNOT .DATA LIBR=FCSRES:RO .DATA // .CLOSE TKB @TTYNOT.TKB PIP TTYNOT.TKB;*/DE/NM #-h- users.r 3072 asc 05-aug-83 17:17:47 sventek (joseph sventek) #-h- defns 223 asc 18-apr-82 07:10:42 v1.1 (sw-tools v1.1) # symbol definitions used by: users # should be placed on a file named defns # define(CHARS_PER_COL,16) # number of character positions per column define(DEFAULT_NO_COL,5) # default number of columns include mailsym #-h- main 2699 asc 16-jun-83 13:08:33 sventek (joseph sventek) DRIVER(users) character buf(MAXLINE), file(FILENAMESIZE), obuf(MAXLINE), name(MAX_TOK) character defn(MAX_TOK) integer getlin, ctoi, getwrd, isatty, getarg, adrpth, index integer nxtcol, i, ncol, verbos, rm, j, junk, debug filedes fd, fopen string msgdir "~msg/" string addr "address" string malias "malias" string offlin "Offending line: " string terms ":?@n" call query("usage: users [-{ | v}]") if (isatty(STDOUT) == NO) ncol = 1 else ncol = DEFAULT_NO_COL verbos = NO debug = NO for (i=1; getarg(i, file, FILENAMESIZE) != EOF; i=i+1) if (file(1) == '-') if (IS_DIGIT(file(2))) { i = 2 ncol = ctoi(file, i) } else if (file(2) == 'v' | file(2) == 'V') verbos = YES else if (file(2) == 'd' | file(2) == 'D') debug = YES else call badarg(file) else call badarg(file) if (verbos == YES | debug == YES) ncol = 1 rm = ncol * CHARS_PER_COL call inpack(nxtcol, rm, obuf, STDOUT) if (debug == NO) { call concat(msgdir, addr, file) if (fopen(file, READ, fd) != ERR) { while (getlin(buf, fd) != EOF) { i = 1 j = getwrd(buf, i, name) + 1 if (verbos == YES) { call skipto(buf, i, '"') if (buf(i) != EOS) { call chcopy(' ', name, j) call chcopy('(', name, j) for (i=i+1; buf(i) != '"' & buf(i) != '@n'; i=i+1) call chcopy(buf(i), name, j) call chcopy(')', name, j) } } call dopack(name, nxtcol, rm, obuf, STDOUT) } call flpack(nxtcol, rm, obuf, STDOUT) call close(fd) } else call error("Cannot open address file") } if (debug == NO) call concat(msgdir, malias, file) else call strcpy(malias, file) if (fopen(file, READ, fd) != ERR) # have the malias file opened { while (getlin(buf, fd) != EOF) { i = 1 call skipbl(buf, i) if (buf(i) != '@n' & buf(i) != '#') # something to do { for (j=1; index(terms, buf(i)) == 0; i=i+1) call chcopy(buf(i), name, j) if (buf(i) == '?' & debug == NO) name(1) = EOS else if (buf(i) == '@n') { call remark("Bad format in alias file") call logmsg(offlin, buf, ERROUT) break # bad format in alias file } if (verbos == NO) { junk = adrpth(name, defn) call strcpy(defn, name) } repeat { if (index(buf, ';') > 0) break junk = getlin(buf, fd) } until (junk == EOF) if (name(1) != EOS) call dopack(name, nxtcol, rm, obuf, STDOUT) } } call close(fd) call flpack(nxtcol, rm, obuf, STDOUT) } DRETURN end #-h- vmsdef 22 asc 05-aug-83 17:17:50 sventek (joseph sventek) define(smtptx,vmtptx) #-h- vmstomsg.r 6340 asc 06-aug-83 11:12:27 system (the system) #-h- main 3512 asc 16-jun-83 13:09:57 sventek (joseph sventek) include netsym include mailsym subroutine main # dummy receiver task for VMS liam (backwards mail) integer desc, n, ibuf, nrcpt, junk integer init, netrcv, netsnd, length, sndmlr, remove, isaliv character buf(MAXLINE), token(MAX_TOK), addr(MAX_TOK), path(MAX_TOK), from(MAX_TOK), subj(MAXLINE), host(HOST_SIZE), c, file(FILENAMESIZE) character gadtok filedes fd filedes fcreat equivalence (ibuf, buf(1)) PB_DECL(MAXLINE) # push back buffer for parsing To: string string mailfr MAIL_FROM_STR string rcptto RCPT_TO_STR string datast DATA_STR string tost "To: " string blanks " " string subjct "Subject: " string datest "Date: " string fromst "From: " string pname "vmsrcvr?" string vms "vms" string mailer "mailer" call minit(pname) if (isaliv(mailer) == NO) call error("VMSRCVR - Mailer not responding") call scratf(vms, file) if (fcreat(file, WRITE, fd) == ERR) call error("Error creating scratch file for message") if (init(desc, host) == ERR) call error("Error accepting connect request") else { n = netrcv(desc, buf, MAXCARD) if (n == EOF) call shut(desc, "Error receiving user name") for ( ; n > 0; n = n - 1) if (buf(n) != ' ') break buf(n+1) = EOS call concat(host, buf, token) call cvtadr(token, from, path) call angbrk(mailfr, path, fd) nrcpt = 0 repeat { n = netrcv(desc, buf, MAXCARD) if (n == EOF) call shut(desc, "Error receiving recipient name") if (buf(1) != EOS) { nrcpt = nrcpt + 1 buf(n+1) = EOS call cvtadr(buf, addr, path) call angbrk(rcptto, path, fd) ibuf = 1 if (netsnd(desc, buf, 4) == ERR) call shut(desc, "Error sending acknowledgement for recipient") } } until (buf(1) == EOS) # record of 1 null ==> end n = netrcv(desc, buf, MAXCARD) if (n == EOF) call shut(desc, "Error receiving To: list") buf(n+1) = EOS call putlnl(datast, fd) n = index(host, ':') host(n) = EOS call pstmrk(host, fd) call putlin(datest, fd) call ptdate(fd) call putlin(fromst, fd) call putlnl(from, fd) n = netrcv(desc, subj, MAXCARD) if (n == EOF) call shut(desc, "Error receiving Subj: string") subj(n+1) = EOS if (subj(1) != EOS) # have a subject line call logmsg(subjct, subj, fd) call pbinit(MAXLINE) call putbak('@n') call pbstr(buf) call putlin(tost, fd) n = 10 repeat { c = gadtok(token, MAX_TOK) call cvtadr(token, addr, path) m = length(addr) if((n + m + 1) > 80) { call putch(',', fd) call putch('@n', fd) call putlin(blanks, fd) n = 10 } if (n > 10) call putch(',', fd) call putch(' ', fd) call putlin(addr, fd) n = n + m + 2 } until (c == '@n') call putch('@n', fd) call putch('@n', fd) repeat { n = netrcv(desc, buf, MAXCARD) if (n == EOF) call shut(desc, "Error receiving line of message") if (n == 1 & buf(1) == EOS) # end of message break if (n == 0) # null line call putch('@n', fd) else { buf(n+1) = EOS call putlnl(buf, fd) } } call close(fd) # close the file if (sndmlr(file) != OK) call shut(desc, "Error queueing mail to mail delivry system") for (n = 1; n <= nrcpt; n = n + 1) { ibuf = 1 if (netsnd(desc, buf, 4) == ERR) call shut(desc, "Error acknowledging message body") } junk = remove(file) call shut(desc, "Successful termination of session") } return end #-h- init 856 asc 13-jun-83 14:36:10 sventek (joseph sventek) integer function init(desc, host) integer desc, status, type, xtra, junk, i, j integer netopn, netgnd, netacc, netcls ifnotdef(PDP_RSX) integer trnlog enddef character buf(CON_BLK_SIZE), host(HOST_SIZE) if (netopn(status) == OK) { status = netgnd(buf, type, xtra) if (status != ERR) { if (type != CON_REQ) status = ERR else status = netacc(buf, 0, 0, desc) } if (status == ERR) junk = netcls(junk) else { ifdef(PDP_RSX) for (i = 25, j = 1; i <= 30; i = i + 1, j = j + 1) if (buf(i) == ' ') break else host(j) = buf(i) call chcopy(':', host, j) call chcopy(':', host, j) elsedef junk = trnlog("SYS$NET", buf) for (i = 1; buf(i) != '"'; i = i + 1) host(i) = buf(i) host(i) = EOS enddef } } return(status) end #-h- shut 164 asc 10-nov-82 23:21:07 tools (lblh csam sventek) subroutine shut(desc, str) integer desc, junk integer netdsc, netcls character str(ARB) junk = netdsc(desc, 0, 0) junk = netcls(junk) call error(str) return end #-h- cvtadr 805 asc 06-aug-83 10:26:27 system (the system) subroutine cvtadr(token, addr, path) character token(MAX_TOK), addr(MAX_TOK), path(MAX_TOK) integer i, j, junk integer indexs, adrpth, rindex string colcol "::" string blklss " <" i = 1 j = 1 while (indexs(token(i), colcol) != 0) { call chcopy('@@', path, j) while (token(i) != ':') { call chcopy(token(i), path, j) i = i + 1 } i = i + 2 # skip over "::" call chcopy(',', path, j) } call stcopy(token, i, path, j) # user name call unrot8(path) # convert to legal path j = 1 call chcopy('"', addr, j) # must sandwich x::y::z in quotes call stcopy(token, 1, addr, j) for (j = j - 1; j > 0; j = j - 1) if (addr(j) != ' ') break j = j + 1 call chcopy('"', addr, j) call stcopy(blklss, 1, addr, j) call stcopy(path, 1, addr, j) call chcopy('>', addr, j) return end #-h- pstmrk 622 asc 19-nov-82 17:01:41 sventek (joseph sventek) subroutine pstmrk(host, fd) character host(HOST_SIZE), zone(4), date(10), time(10) integer i, now(7) filedes fd string decnet "decnet" string s1 "Received: from " string s2 " by " string s3 " with VMS ; " call putlin(s1, fd) call putlin(host, fd) call putlin(s2, fd) call gthost(decnet, host) call putlin(host(2), fd) call putlin(s3, fd) call getnow(now) call gtzone(zone) call fmtdat(date, time, now, LETTER) for (i = 1; date(i) != EOS; i = i + 1) if (date(i) == '-') date(i) = ' ' call putlin(date, fd) call putch(' ', fd) call putlin(time, fd) call putch(' ', fd) call putlnl(zone, fd) return end #-h- vmtptx.r 8061 asc 05-aug-83 17:17:56 sventek (joseph sventek) #-h- vmtptx 6316 asc 05-aug-83 16:06:50 sventek (joseph sventek) include mailsym integer function vmtptx(host, buf, file, nref, efile) character file(FILENAMESIZE), host(HOST_SIZE), buf(MAXLINE), temp(MAX_TOK), badlst(MAXLINE), tolist(MAXLINE), rfile(FILENAMESIZE), efile(FILENAMESIZE), mlfrom(MAX_TOK) integer stat, junk, desc, naddr, nbad, pt, pb, n, toaddr, i, found, ifrtry, last, nretry, nref integer netopn, netcon, getlin, match1, index, length, netsnd, vmssts, note, netdsc, netcls, adrpth, getwrd filedes fd, rfd filedes fopen, fcreat linepointer addr string null "" string msg0 "Error opening file: " string msg1 "Error declaring self as a network task" string msg2 "Error establishing connection, host = " string msg3 "Invalid line format: " string msg4 "Error creating retry file: " string msg5 "Queued retry file from Vmtptx: " string colcol "::" string comblk ", " string arrstr ARRIVAL_TIME_STR string fromst MAIL_FROM_STR string rcptst RCPT_TO_STR string subjst "Subject: " string rseed "vretry." string rtfile "~msg/vmtptx.tmp" data last/0/ nref = 0 if (fopen(file, READ, fd) == ERR) { call errlog(msg0, file, L_INT) return(ERR) } call mgenr8(last, rseed, rfile) if (fcreat(rtfile, WRITE, rfd) == ERR) { call close(fd) call errlog(msg4, rtfile, L_INT) return(ERR) } stat = ERR if (netopn(junk) == ERR) call errlog(null, msg1, L_COMM) else { call upper(host) call netbcb(buf, host, 27, 0, null, null, null, null) if (netcon(buf, null, 0, temp, 16, junk, desc) == ERR) call errlog(msg2, host, L_COMM) else { call concat(host, colcol, host) naddr = 0 nbad = 0 nretry = 0 pt = 1 pb = 1 ifdef(PDP_RSX) call altpri(75) # high priority during xmit enddef for (n = getlin(buf, fd); n != EOF; n = getlin(buf, fd)) { stat = OK if (match1(buf, arrstr) == YES) # end of header stuff { call putlin(buf, rfd) break } if (match1(buf, fromst) == YES) # MAIL FROM:<> { call putlin(buf, rfd) # need for possible retries call xtrpth(buf, mlfrom) call pthadr(mlfrom, buf) call adrvms(buf, temp) toaddr = NO } else if (match1(buf, rcptst) == YES) # RCPT TO:<> { call xtrpth(buf, temp) call pthadr(temp, buf) call adrvms(buf, temp) if (match1(temp, host) == YES) # strip off dest host name { i = index(temp, ':') + 2 call scopy(temp, i, temp, 1) } toaddr = YES } else { call errlog(msg3, buf, L_INT) next } call errlog("T: ", temp, L_BABBLE) n = length(temp) stat = netsnd(desc, temp, n) if (stat == ERR) break if (toaddr == YES) { stat = vmssts(desc, buf, ifrtry) if (stat == ERR) break if (stat == OK) { naddr = naddr + 1 if (pt > 1) call stcopy(comblk, 1, tolist, pt) call stcopy(temp, 1, tolist, pt) } else if (ifrtry == YES) { nretry = nretry + 1 call concat(host, temp, buf) call vmsadr(buf, temp) junk = adrpth(temp, buf) call angbrk(rcptst, buf, rfd) } else { nbad = nbad + 1 if (pb > 1) call chcopy(' ', badlst, pb) call stcopy(host, 1, badlst, pb) call stcopy(temp, 1, badlst, pb) } } } if (n == EOF) stat = ERR if (stat != ERR) stat = netsnd(desc, null, 1) # end of mail recipients list call errlog("T: ", tolist, L_BABBLE) if (stat != ERR) stat = netsnd(desc, tolist, length(tolist)) if (stat != ERR) { junk = note(addr, fd) # note the top of the message found = NO while (getlin(buf, fd) != EOF) { call scrypt(buf) if (match1(buf, subjst) == YES) { found = YES break } } call seek(addr, fd) # go back to top of message if (found == YES) { i = index(buf, ':') + 1 call skipbl(buf, i) call scopy(buf, i, buf, 1) i = length(buf) buf(i) = EOS } else { buf(1) = ' ' buf(2) = EOS } call errlog("T: ", buf, L_BABBLE) stat = netsnd(desc, buf, length(buf)) } if (stat != ERR) for (n = getlin(buf, fd); n != EOF; n = getlin(buf, fd)) { call scrypt(buf) n = n - 1 if (n <= 0) { n = 1 buf(1) = ' ' } stat = netsnd(desc, buf, n) } if (stat != ERR) stat = netsnd(desc, null, 1) # end of message if (stat != ERR) { pt = 1 for (i = 1; i <= naddr; i = i + 1) { call skipbl(tolist, pt) stat = vmssts(desc, buf, junk) if (stat == ERR) break if (stat != OK) { if (pb > 1) call chcopy(' ', badlst, pb) call stcopy(host, 1, badlst, pb) while (tolist(pt) != ',' & tolist(pt) != EOS) call chcopy(tolist(pt), badlst, pb) nbad = nbad + 1 } call skipto(tolist, pt, ' ') } } ifdef(PDP_RSX) call altpri(45) enddef if (stat != ERR) if (nretry > 0) # some retries to qeue { call seek(addr, fd) # find top of message call fcopy(fd, rfd) # append to file } junk = netdsc(desc, null, 0) } junk = netcls(junk) } call close(rfd) if (stat == ERR | nretry == 0) junk = remove(rtfile) else { junk = amove(rtfile, rfile) call errlog(msg5, rfile, L_TRACE) } if (stat != ERR & nbad > 0) { if (fcreat(efile, WRITE, rfd) != ERR) { call putlnl("Addresses refused by VMS mail receiver", rfd) i = 1 while (getwrd(badlst, i, temp) > 0) { call vmsadr(temp, buf) junk = adrpth(buf, temp) call putch('<', rfd) call putlin(temp, rfd) call putlnl(">", rfd) } call angbrk(fromst, mlfrom, rfd) call seek(addr, fd) call fcopy(fd, rfd) call close(rfd) nref = nbad } } call close(fd) return(stat) end #-h- adrvms 418 asc 16-nov-82 23:24:52 sventek (joseph sventek) subroutine adrvms(addr, vmsadr) character addr(MAX_TOK), vmsadr(MAX_TOK) integer i, j, k, n integer length string colcol "::" j = 1 n = length(addr) repeat { for (i = n; i > 0; i = i - 1) if (addr(i) == '@@') break for (k = i + 1; k <= n; k = k + 1) call chcopy(addr(k), vmsadr, j) if (i > 0) call stcopy(colcol, 1, vmsadr, j) n = i - 1 } until (n <= 0) call upper(vmsadr) return end #-h- vmssts 657 asc 17-nov-82 21:52:39 tools (lblh csam sventek) integer function vmssts(desc, buf, ifrtry) character buf(MAXLINE) integer desc, stat(2), n, status, ifrtry integer netrec, indexs string null "" string notavl "SYSTEM-F-UNREACHABLE" if (netrec(desc, stat, 4) == EOF) status = ERR else if (stat(1) == 1) status = OK else { status = EOF ifrtry = NO # assume bad address repeat { n = netrec(desc, buf, MAXLINE) if (n == EOF) { ifrtry = NO status = ERR break } if (buf(1) == EOS) break buf(n+1) = EOS call errlog(null, buf, L_COMM) if (indexs(buf, notavl) > 0) # host not available ifrtry = YES } } return(status) end #-h- vmsadr 360 asc 17-nov-82 21:52:39 tools (lblh csam sventek) subroutine vmsadr(vms, addr) character vms(MAX_TOK), addr(MAX_TOK) integer i, j, k, n integer length j = 1 n = length(vms) repeat { for (i = n; i > 0; i = i - 1) if (vms(i) == ':') break for (k = i + 1; k <= n; k = k + 1) call chcopy(vms(k), addr, j) if (i > 0) call chcopy('@@', addr, j) n = i - 2 } until (n <= 0) return end #-h- netbld.sh 175 asc 06-aug-83 11:12:34 system (the system) echo "/UNITS=8/s//UNITS=10@nGBLPAT=$2:R_FMSK:1/" >t.sed echo '/_/s//@$/' >>t.sed sedit <~bin/tools.tkb >tools.tkb -f t.sed $1 -v $3 $4 $5 $6 $7 $8 $9 -lmsg rm tools.tkb t.sed