;;;-*-midas-*- title mails ;;;chaosnet mail server f=0 a=1 b=2 c=3 d=4 e=5 t=10 tt=11 p=17 .insrt system;chsdef nw%chs==7 ;standard network number for chaosnet dskoch==0 ;output channel for mail queue file errich==1 ;input channel for ERR: device chaich==10 ;chaosnet input channel chaoch==11 ;chaosnet output channel ranch==12 ;random channel ;;;storage debug: 0 ;non-zero => .value on barfage chapkt: block %cpmxw ;chaosnet packet goes here errcod: 0 ;error code iocflg: 0 ;detect recursive ioc errors netcnt: 0 ;number of characters in network buffer netbfp: 0 ;byte pointer to that dskcnt: dbfsiz ;room in disk output buffer dskbfp: 440700,,dskbuf ;output byte pointer npdl==37 pdl: block npdl ;;;interrupt handler tsint: loc 42 -tsintl,,tsint loc tsint p %piioc ? 0 ? -1 ? -1 ? iocerr ;handle ioc errors tsintl==.-tsint ;;;internal error handler die: 0 ;jsr here skipe debug .value passon: .logout ;natural causes .value sndpkt: setz ? 'PKTIOT ? movei chaoch ? setzi chapkt rcvpkt: setz ? 'PKTIOT ? movei chaich ? setzi chapkt ;;;main program go: .close 1, ;this can still be open from loading us move p,[-npdl,,pdl-1] .suset [.roption,,t] tlo t,optint ;new style interrupts .suset [.soption,,t] .suset [.smask,,[%piioc]] ;catch ioc errors .call [setz ? 'CHAOSO ? movei chaich ? movei chaoch ? setzi 5] jsr die move t,[.byte 8 ? %colsn ? 0 ? 0 ? 4] movem t,chapkt move t,[.byte 8 ? "M ? "A ? "I ? "L] movem t,chapkt+%cpkdt .call sndpkt jsr die movei t,30.*60. skipe debug hrloi t,177777 ;wait forever if debugging .call [setz ? 'NETBLK ? movei chaich ? movei %cslsn ? t ? setzm t] jsr die caie t,%csrfc ;did we get an rfc for this? jsr die .call rcvpkt ;yes, read it in jsr die pushj p,bloatp ;Don't accept mail if directory is full jrst full skipe debug ;debugging? jrst accept ldb t,[chapkt+$cpksa] ;get source host address move tt,[sixbit /000C00/] ;convert host number to sixbit dpb t,[220300,,tt] lsh t,-3 dpb t,[300300,,tt] lsh t,-3 dpb t,[360300,,tt] .suset [.ruind,,t] ;incoroporate user index also dpb t,[000300,,tt] lsh t,-3 dpb t,[060300,,tt] move t,tt ;save copy for xuname movei a,100(tt) ;loop only 100 times login: cain tt,(a) jsr die ;can't log in, must be broken somehow .call [setz sixbit /LOGIN/ tt ? [sixbit /CHAOS/] ? setz t] aoja tt,login ;error, perhaps need to try other uname .suset [.sjname,,[sixbit /MAIL/]] .call [setz ? 'DETACH ? movei %jself ? andi 3 ] jsr die ;;;looks ok to accept the rfc accept: .call [ setz sixbit /OPEN/ movsi .uao moves errcod movei dskoch [sixbit /DSK/] [sixbit /_MAILS/] [sixbit /OUTPUT/] setz [sixbit /.MAIL./]] jrst calerr ;error opening file, return CLS movei a,[asciz /NET-MAIL-FROM-HOST:/] pushj p,dsksou ldb a,[chapkt+$cpksa] ;foreign host hrli a,nw%chs_9 pushj p,dsknou ;output number movei a,[asciz / /] pushj p,dsksou movei t,%coopn dpb t,[chapkt+$cpkop] .call sndpkt jsr die ;;;read the names of all the recipients rcplup: pushj p,charch ;get a character jsr die cain b,215 ;end of line jrst txtlup ;yes, go get text of message push p,b movei a,[asciz /RCPT:/] pushj p,dsksou pop p,b namlup: pushj p,dskwch pushj p,charch jsr die caie b,215 ;end of one? jrst namlup ;no, keep reading this name rcplp1: movei a,[asciz / /] pushj p,dsksou ;end line movei a,[asciz /+Recipient name accepted./] pushj p,netsou jrst rcplup ;go get some more ;;;read in the text of the message txtlup: movei a,[asciz /TEXT;-1 /] pushj p,dsksou txtlp1: pushj p,charch ;get next character jrst txtlp2 ;eof, finish up cain b,215 ;cr? jrst [ movei b,15 pushj p,dskwch movei b,12 jrst .+1] pushj p,dskwch ;output it jrst txtlp1 txtlp2: pushj p,dskwbf ;force out buffered file output .call [ setz sixbit /RENMWO/ moves errcod movei dskoch [sixbit /MAIL/] setz [sixbit />/]] jrst calerr .call [ setz ;Write out directory to disk sixbit /FINISH/ moves errcod setzi dskoch ] jrst calerr .call [ setz sixbit /CLOSE/ moves errcod setzi dskoch] jrst calerr movei a,[asciz /+Mail queued successfully./] pushj p,netsou .call [ setz sixbit /FINISH/ setzi chaoch] jrst passon .close chaoch, .close chaich, jrst passon ;;;ioc error comes here iocerr: aosn iocflg ;recursive ioc error? jsr die ;yes, just die .suset [.rbchn,,t] caie t,dskoch ;only meaningful for dsk output channel jsr die ;else just go away setom iocflg ;mark to detect recursive ioc errors move a,-2(p) ;previous DF1 word .suset [.sdf1,,a] move a,-1(p) ;previous DF2 word .suset [.sdf2,,a] jrst dskerr ;;;error opening, or ioc error, return a CLS of the error message calerr: movei tt,3 ;get error from .call skipa t,errcod dskerr: movei tt,2 ;enter here with offending channel in t snderr: .call [ setz sixbit /OPEN/ movsi .uai movei errich [sixbit /ERR/] movei (tt) setz t] jsr die move a,[441000,,chapkt+%cpkdt] movei b,0 snderl: .iot errich,tt caige tt,40 ;stop on first control char jrst snderc idpb tt,a aoja b,snderl snderc: .close errich, dpb b,[chapkt+$cpknb] movei b,%cocls dpb b,[chapkt+$cpkop] .call sndpkt jsr die jrst passon ;;;output a string to the network, address of asciz string in a, should be short since this ;;;is slow. follows string with newline. netsou: hrli a,440700 netso1: ildb b,a jumpe b,netso2 .iot chaoch,b jrst netso1 netso2: .iot chaoch,[215] ;newline .nets chaoch, popj p, ;;;output a string to the mail file, address of asciz string in a dsksou: hrli a,440700 dskso1: ildb b,a jumpe b,cpopj pushj p,dskwch jrst dskso1 ;;;output a number to the mail file, number in a dsknou: jumpe a,cpopj idivi a,10 push p,b pushj p,dsknou pop p,b addi b,"0 pushj p,dskwch cpopj: popj p, ;;;get a character from the network, skip returns with char in b, single return for eof charch: sosge netcnt ;still some characters in the buffer? jrst charcb ;no, get a new buffer ildb b,netbfp cpop1j: aos (p) popj p, charcb: .call rcvpkt ;refill buffer, actually read another packet jsr die ldb t,[chapkt+$cpkop] cain t,%coeof ;eof? popj p, ;yes, single return for that caige t,%codat ;must otherwise be data jsr die move t,[440800,,chapkt+%cpkdt] movem t,netbfp ldb t,[chapkt+$cpknb] movem t,netcnt jrst charch ;go return first char ;;;output a character to the disk file, character in b dskwch: idpb b,dskbfp sosle dskcnt ;room in output buffer for more? popj p, ;yes, return dskwbf: move t,[440700,,dskbuf] ;force out buffered disk output movem t,dskbfp movei tt,dbfsiz subm tt,dskcnt exch tt,dskcnt ;get count of characters to output .call [ setz sixbit /SIOT/ moves errcod movei dskoch t ? setz tt] jrst calerr popj p, full: movei t,%cocls dpb t,[chapkt+$cpkop] movei t,.length/Mailer too busy to accept mail now/ dpb t,[chapkt+$cpknb] movei t,[asciz/Mailer too busy to accept mail now/] hrli t,440700 move a,[440800,,chapkt+%cpkdt] full1: ildb tt,t idpb tt,a jumpn tt,full1 .call sndpkt jsr die jsr die ;Refuse to accept the mail if more than 30 queued mail files. ;Skip if not bloated ;This is an attempt to avoid bloating the mailer so the dir fills ;up and it dies needing human intervention. bloatp: .call [ setz ? sixbit/OPEN/ ? [.uai,,ranch] ? [sixbit/DSK/] [sixbit/MAIL/] ? [SIXBIT/>/] ? setz [sixbit/.MAIL./]] jrst blotp9 .call [ setz ? sixbit/RFNAME/ ? movei ranch movem b ? movem b ? setzm b ] .lose %lssys .call [ setz ? sixbit/OPEN/ ? [.uai,,ranch] ? [sixbit/DSK/] [sixbit/MAIL/] ? [SIXBIT/-<':_6> ;Don't worry about additional carries, close enough for gov't work camg b,c blotp9: aos (p) popj p, dbfsiz==2000 dskbuf: block dbfsiz+4/5 end go