.title NetSrv .inclu "b:global" ;+ ; NetSrv extracts all texts to Internet from KOM and reverse. ; ; Input files: *.KIN ; Output files: *.INT ; ; If an error occours, the file extension is changed as follow: ; ; Extension Error ; ~~~~~~~~~ ~~~~~ ; ; E00 Resiver not in KOM. ; E01 Required header not found. ; E02 Empty file. ; E99 Unknown error. ; ;- APR1 = 1 APR2 = 2 APR3 = 3 APR4 = 4 APR5 = 5 KIN = 7 ; Channel to use for Writing news Tab = 11 Spc = 40 RhtLim = 75. RhtMrg = 120. .psect code .inclu "b:komfil" ; KOM filedefinitions. INIT:: .ttnch ; No Echo mov #^RINT, firqb+fqnam1 mov #^RSRV, firqb+fqnam1+2 .name ; Set work name clr Me mov #LinLen-2, MaxLin mov #-1, Line clr PTerm ; Default term-typ (dummy crt) clrb xrb+xrci .postn mov #Width,r0 clr (r0) ; ? movb xrb,(r0) decb (r0) movb firqb+fqjob, r0 asr r0 mov r0, Job write #WlkMes ; Write a friendly phrase with version. errprt #0 write #CRLF mov #xSM+xELIN+xFil, MyFlags mov #UnProm, Stat clr KSW movb #UU.SYS,Firqb+fqfun clr firqb+4 .UUO mov firqb+26,PPN movb Firqb+5,TERM OPFIL: mov #EOFS,r2 ; Open files mov #EOFS-Files, r0 ; Number of files * 2 10$: mov #firqb+fqfun, r1 movb #opnfq, (r1)+ mov r0, (r1)+ ; Unit number * 2 mov KOMPPN, (r1)+ mov #^RKOM, (r1)+ mov -(r2), (r1)+ mov #^RDAT, (r1)+ mov #1+8.+128.+32768., firqb+fqmode mov KOMDEV, firqb+fqdev mov KOMDVN, firqb+fqdevn calfip jsr pc, error dec r0 sob r0, 10$ write #CRLF ; Attach to KOM overlay library. call clrfqb movb #ATRFQ, Firqb+fqfil mov KOMLIB, Firqb+12 mov KOMLIB+2, Firqb+14 mov #1, Firqb+22 ; Read Only. .plas ; Attach Resedent Library call Error mov Firqb+Fqppn, OLIde ; mov Firqb+Fqnam1, OLSiz call clrfqb movb #CRAFQ, Firqb+Fqfil movb #APR3, Firqb+7 mov #Firqb+12,r1 mov #128., (r1)+ mov OLIde, (r1)+ mov OvlTbl+SegB, (r1)+ mov OvlTbl+SegB+2, (r1)+ mov #200,(r1) ; ReadOnly, Mapping. .plas call Error mov firqb+fqppn, OWIde ; Window ID mov #SegB, curseg ; Current maped segment. ; Attach to KOM group-and command library. call clrfqb movb #ATRFQ, Firqb+fqfil mov KOMRES, Firqb+12 mov KOMRES+2, Firqb+14 mov #2, Firqb+22 .plas ; Attach Resedent Library call Error mov Firqb+Fqppn, LibIde mov Firqb+Fqnam1, LibSiz call clrfqb movb #CRAFQ, Firqb+Fqfil movb #APR4, Firqb+7 mov #Firqb+12,r1 ; There WAS a bug here! mov #128., (r1)+ mov LibIde, (r1)+ clr (r1)+ clr (r1)+ mov #202, (r1) ; Write access and Mapping .plas call Error mov firqb+fqppn, WinIde ; Window ID clr CurSek ; Current maped sektion. mov #100, ResLim bis #UseRes, KSW ; Now we uses a RESLIB ; for our commands. mov #2,r2 gos Get, <#1, r2, #FB1, #1, #Lock> ; Get INFO-block cmp #xDBVer, FB1+32 ; Right DATABASE Version beq 20$ iot 20$: bit #1, FB1+34 beq 40$ mov #1,r0 call Releas Write #KOMAVS jmp $exit 40$: mov FB1+62, IntGrp mov FB1+110, HshSiz mov FB1+112, HshEnd ALIINI: mov #Alias1, r1 ; Alias INIT. mov r1, LstMem clr (r1)+ mov #GRPLST, (r1)+ ; Link to KOMRES. clr (r1)+ ; rArg clr (r1)+ ; Priority none. clr (r1)+ ; rPri2 clr (r1)+ ; rTyp clr (r1)+ ; rStr mov r1, NxtMem mov #BasAdr, r5 ; LIBINF cmp #xLibUi, (r5) beq RESINI jmp CONT RESINI: mov #1, r0 ; Init. Resedent Library call Exlock mov #xLibIn, (r5)+ mov FB1+22, (r5)+ ; # of created text's mov FB1+24, (r5)+ mov #17, (r5)+ ; Edit # for groups mov #17, (r5)+ ; Edit # for texts mov FB1+34, (r5)+ ; DSW clr (r5)+ ; LSW2 mov #FB1+62, r1 mov (r1)+, (r5)+ ; N[TPERSON n movb (r1)+, r0 movb r0, (r5)+ 5$: movb (r1)+, (r5)+ ; KOM's net-address sob r0, 5$ mov #PreLst, r1 call GetAdr mov r1, r5 mov #64.*4, r0 10$: clr (r5)+ sob r0, 10$ mov FB1+30, r4 ; Number of groups. mov FB1+42, tmp mov #FSTGRP, NxtAdr ; Start addres of grouplist mov #GRPLST, LstAdr ; Previous linked group. mov LibSiz, r1 asr r1 asr r1 bic #177037, r1 mov r1, LibSiz ; Highest possible sektion. clr r1 ; Number of linked groups. INLNK: mov r4,r3 beq 50$ cmp #</1000>*10, r3 ; Maximum number of groups bhis 10$ ; to be read. mov #</1000>*10, r3 10$: mov r3,r5 dec r5 ash #-3,r5 ; Number of blocks left to get inc r5 mov #stkend+2,r0 gos Get, <#4, r2, r0, r5, #Unlock> add r5,r2 20$: inc r1 dec r4 tst (r0) beq 30$ call maklst cmp #-1, NxtAdr beq 50$ 30$: add #64.,r0 sob r3,20$ br INLNK 50$: mov #LibInf, r1 call GETADR mov r1,r5 add #100, r1 mov LstAdr, (r1)+ mov NxtAdr, (r1)+ mov LibSiz, (r1) mov #xLibRd, (r5) mov #1, 10(r5) ; Edit # for texts mov #Mutex, r1 call GetAdr mov #-1, (r1)+ ; Init value for this semaphore. clr (r1)+ ; Owner job nr (no one now). CONT: mov #1, r0 call Releas 505$: cmp #xLibRd, (r5) beq 530$ 510$: cmp #xLibIn, (r5) ; This is not possible! beq 520$ ; You can't be here! iot 520$: mov #2, xrb .sleep br 505$ 530$: mov 6(r5), EditNr PseWho:: mov #stack, sp mov #ovlstk, ovlsp mov IntGrp, r0 mov r0, Me mov #GRPLST, r1 call FindCm tst r0 bne 10$ jmp quit$ 10$: mov rArg-rStr(r0), MyRec mov rHigh-rStr(r0), MyHigh gos GetMe, <#FB1> clr NrCrTx ; # of created texts mov 102(r1), MyRead mov 104(r1), MyPoin mov 106(r1), FileNr RNEWS: mov me, r0 call GetHig mov r0, MyHigh mov MyRead, r0 cmp MyRead, MyHigh bhis WNEWS call FixLet tst unrel beq WNEWS tst @unrel beq WNEWS 10$: call RdLet mov MyRead, r0 tst @unrel bne 10$ br RNEWS WNEWS: clr r5 10$: gos wopen <#KIN,#INFILE,>; Wild open next file (always first ; file) bcs $FIN mov #'<, r0 call ttyout call WrFiNa inc r5 gos DoWrtN bcs 20$ call RstFqb call kill ; Don't need the file no more! br 10$ 20$: call RstFqb gos Rename ; Change the files extension br 10$ ; to ErrExt. $FIN: call MtxBgn gos LockMe, <#FB1> add NrCrTx, 100(r1) mov MyRead, 102(r1) mov MyPoin, 104(r1) mov FileNr, 106(r1) gos Put, <#1,, #FB1> call MtxEnd call pcrlf jmp quit$ proc DoWrtN var EB, word var EO, word var TB, word var TO, word var RC, word ; Receiver of this letter! var CT, word ; Comment-To text # (physical) var SW, word ; Status Word for TEXT var HashNr, word begin clr CT(r5) ; Comment to nothing by default mov #xEXT!xEXIN, SW(r5) ; Default status word clr NrLine ; # of lines in text clr NrHdrL ; # of header lines clr NrRece ; Nr of receivers clrb SubBuf ; Subject-line. clrb SndBuf ; Sender-line. ; 1'st thing: Get the recievier and the In-Rep-To-field from the text. ; At the same time: Count # of lines and move from:- and sender:-lines ; to the top. mov #FB1, r4 gos Get, <#-KIN, #1, r4, #1,> bcc 5$ 2$: mov #^RE02, ErrExt 3$: jmp 4711$ ; Why send an empty file? 5$: gos RdLine ; Get receiver line. bcs 2$ ; Error! It had to be a receiver. call GetRce mov r0, RC(r5) bne 10$ mov #^RE00, ErrExt ; Receiver not in KOM. br 3$ 10$: cmp #1, r1 ; Is receiver a person? bne 12$ ; No! bis #xBrev, SW(r5) ; Yes, send it as a letter. 12$: gos GetHdL <#False> ; Returns ptr in r1, len in r0. bcs 3$ ; End Of file => No text at all. tst r0 bne 15$ tst EoHdP bne 100$ 15$: mov 20$(r2), r2 beq 50$ call @r2 br 50$ 20$: .word SavFrm ; From .word 0 ; To .word SavSnd ; Sender .word 0 ; Bcc .word 0 ; Date .word 40$ ; Message-Id .word 0 ; Reply-To .word 30$ ; In-Reply-To .word 0 ; Received .word 0 ; cc .word SavSub ; Subject .blkw0 10 ; Outher.. 30$: call GetCom ; Get commented text. mov r0, CT(r5) ; Physical text # or zero. beq 35$ bis #xKom, SW(r5) ; Yes, it's a comment! 35$: rts pc 40$: call GetMId mov r0, HashNr(r5) rts pc 50$: tst MoreP beq 10$ gos GethdL, <#True> bcc 50$ mov #^RE99, ErrExt br 4711$ 100$: tst NrRece bne 105$ tstb SndBuf bne 105$ mov #^RE01, ErrExt br 4711$ ; No author => Return with error! 105$: call RdLine ; Must count nr of lines... bcs 110$ inc NrLine br 105$ ; Ok, now we now what to do! Time to send it to KOM! 110$: call Get1st ; Lock block #1 of file 3. mov r3, EB(r5) ; Save block # for EXTERN node mov r4, EO(r5) ; Calculate offset for EXTERN node mov r3, TB(r5) mov r4, TO(r5) add #FB4, r4 call PtHead bit #1, r4 beq 120$ clr r0 call PutChr ; Evenize.. 120$: mov r4, TO(r5) sub #FB4, TO(r5) mov FB4-2, TB(r5) call PtText call putlst ; Put last block of file 3. Unlock gos mklet2 mov r1, TxtNr mov r0, TxtNr+2 gos IntLnk gos InToHs inc NrCrTx 2000$: mov #2, r4 ; Good! The file was excellent! br 9999$ 4711$: clr r4 ; Error! Return with carry set... 9999$: gos close <#KIN> ; Close the channel in case it was open add r4, pc ; ! sec ret GetCom: push r2 call GetHsh bcs 99$ mov #FB2+2, r2 mov r0, (r2) mov r1, -(r2) mov r2, r0 mov r2, r1 call CnvLet bcc 100$ 99$: clr r0 100$: pop r2 rts pc .rem & ExP: push r0 mov #'>, r0 call ttyout call ttyin cmp #'., r0 beq 10$ pop r0 rts pc 10$: jmp $EXIT ; & proc InToHs begin push mov HashNr(r5), r1 clr r0 div #200, r0 add #2, r0 ; Block Number! (2 = first block) asl r1 asl r1 ; Address in block call MtxBgn gos Get, <#5, r0, #FB4, #1,> add #FB4, r1 mov (r1), r2 ; Block mov ExtBlk(r5), (r1)+ mov (r1), r3 ; Position mov ExtPos(r5), (r1) gos Put, <#5,,#FB4> call MtxEnd tst r3 beq 100$ mov #FB4, r4 gos GetRec <#3, r2, r4,> mov r3, r1 add r4, r1 gos GetWrd <#FB4> cmp #-1, r0 beq 50$ 40$: clr r2 ; Cut of pointer to sick EXTERN. clr r3 br 100$ 50$: gos GetWrd <#FB4> cmp #2, r0 bne 40$ gos GetWrd <#FB4> gos GetWrd <#FB4> mov r1, r4 mov ExtBlk(r5), r0 call PutWrd mov ExtPos(r5), r0 call PutWrd gos Put <#3,, #FB4> 100$: gos GetRec <#3, #1, #FB4,> ; First block. mov #3, r0 call exlock ; Lock it mov #FB4, r4 gos GetRec <#3, ExtBlk(r5), r4,> add ExtPos(r5), r4 mov #-1, r0 call PutWrd mov #2, r0 call PutWrd mov r2, r0 call PutWrd mov r3, r0 call PutWrd clr r0 call PutWrd call PutWrd mov TxtNr, r0 call PutWrd mov TxtNr+2, r0 call PutWrd gos Put, <#3,, #FB4> mov #3, r0 call Releas pop ret PtText: push mov #txhdr, r1 movb (r1)+, r2 10$: movb (r1)+, r0 call PutChr sob r2, 10$ mov NrLine, r0 ; # of lines. inc r0 ; One extra for the subject-line. call PutChr swab r0 call PutChr mov r4, r5 mov r3, r4 mov #Buff2, r3 mov #SubjT, r1 movb (r1)+, r0 call SavLin mov #SubBuf, r1 movb (r1)+, r0 call SavLin call PutLin 50$: call RdLine bcs 999$ ; This will occour.... mov r2, r0 call SavLin call PutLin dec NrLine bne 50$ 999$: mov r4, r3 mov r5, r4 pop rts pc PtHead: push mov #xthdr, r1 movb (r1)+, r2 10$: movb (r1)+, r0 call PutChr sob r2, 10$ mov NrHdrL, r0 call PutChr swab r0 call PutChr mov r4, r5 mov #Buff2, r3 ; r5 = Pinter in FB4, r4 = FB1 (KIN), r3 = buffer. tstb SndBuf beq 40$ mov #'C, r0 call SavChr mov #SndBuf, r1 movb (r1)+, r0 call SavLin call PutLin 40$: mov NrRece, r2 beq 70$ mov #ToBuff, r4 mov #'A, r0 50$: call SavChr movb (r4)+, r0 mov r4, r1 add r0, r4 call SavLin dec r2 beq 60$ call PutLin mov #'+, r0 br 50$ 60$: call PutLin 70$: mov #FB1, r4 gos Get, <#-KIN, #1, r4, #1,> call RdLine bcs 4711$ 80$: clr HdrSpc gos GetHdL, <#False> bcs 4711$ tst r0 bne 85$ tst EoHdP bne 200$ 85$: push r0 mov HdrPrf(r2), r0 beq 190$ tst HeadTB(r2) ; Uknown header? beq 150$ ; Yes => goto 150$ call SavChr 90$: pop r0 call SavLin call PutLin br 170$ 150$: call SavChr push r1 mov #HdrStr, r1 movb (r1)+, r0 beq 170$ mov r0, HdrSpc add #2, HdrSpc bicb #40, (r1) ; Uppercase! call SavLin mov #':, r0 call SavChr mov #Spc, r0 call SavChr pop r1 br 90$ 170$: tst MoreP beq 80$ gos GetHdl, <#True> bcs 4711$ tst r0 beq 170$ push r0 mov #'+, r0 call SavChr mov HdrSpc, r2 beq 180$ mov #Spc, r0 175$: call SavChr sob r2, 175$ 180$: pop r0 call SavLin call PutLin br 170$ 190$: pop r0 195$: tst MoreP beq 80$ gos GetHdL, <#True> bcs 4711$ br 195$ 200$: 2000$: tst (pc)+ 4711$: sec mov r4, r3 mov r5, r4 pop rts pc PutWrd: mov r0, (r4)+ cmp r4, #FB4+1000 blo 100$ gos put <#3, ,#FB4> push r0 mov #FB4-2, r4 mov (r4)+, r0 inc r0 gos Get, <#3 ,r0 ,r4 , #1,> pop r0 100$: rts pc SavChr: movb r0, (r3)+ rts pc SavLin: push tst r0 beq 99$ 10$: movb (r1)+, (r3)+ sob r0, 10$ 99$: pop rts pc PutLin: push mov r5, r4 mov #Buff2, r1 sub r1, r3 mov r3, r0 call PutChr tst r0 beq 99$ 10$: clr r0 bisb (r1)+, r0 call PutChr sob r3, 10$ 99$: mov #Buff2, r3 mov r4, r5 pop rts pc SavFrm: push r3 clr NrRece mov #ToBuff, r3 10$: tst r0 beq 30$ movb r0, (r3)+ 20$: movb (r1)+, (r3)+ sob r0, 20$ inc NrRece 30$: tst MoreP beq 999$ gos GetHdL, <#True> br 10$ 999$: pop r3 rts pc SavSnd: push r3 mov #SndBuf, r3 10$: movb r0, (r3)+ beq 999$ 20$: movb (r1)+, (r3)+ sob r0, 20$ 999$: pop r3 rts pc SavSub: push r3 mov #SubBuf, r3 10$: movb r0, (r3)+ beq 999$ 20$: movb (r1)+, (r3)+ sob r0, 20$ 999$: dec NrHdrL ; This is to be counted as a text- tst MoreP beq 1000$ gos getHdL, <#true> br 999$ 1000$: pop r3 ; line.. rts pc GetMId: push mov #TmpStr, r2 call GetIdS bcs 99$ call HashIt br 100$ 99$: clr r0 100$: pop rts pc ;+ ; EqlHdr checks if current header match header string in r0 ;- EqlHdr: push mov #HdrStr, r1 call EqualP pop rts pc ;+ ; GetHdL (Get-Header-Line) ; Return: Header (In lower case without ":") in HdrStr ; r2, index to HeadTB to found header. ; Rest in LinBuf, r1/r0 = Pos/Len ; Input is terminated at every "," and MoreP is set to True. ;- proc GetHdL, var SpcFlg, word var BraFlg, word var AbrLim, word begin push r3 mov #FB1+1000, r3 ; limit. 1$: clrb LinBuf clr MoreP clr EoHdP mov HdrIdx, r2 tst More(r5) bne 48$ mov #HdrStr, r1 clrb (r1)+ 10$: call GetChr bcc 13$ 12$: jmp 1000$ 13$: cmp #Cr, r0 bne 15$ call GetChr bcs 12$ ; jmp 1000$ cmp #Lf, r0 bne 15$ jmp 500$ 15$: cmp #':, r0 beq 40$ cmp #Spc, r0 ; Skip all headers with spaces beq 17$ ; and tabs before ":" (RFC 821) cmp #Tab, r0 bne 19$ 17$: call Rdline bcs 12$ ; Eof br 1$ ; try next! 19$: cmp #'A, r0 bhi 20$ cmp #'Z, r0 blo 20$ bisb #40, r0 ; Make it lower-case. 20$: movb r0, (r1)+ 30$: br 10$ 40$: sub #HdrStr+1, r1 movb r1, HdrStr ; Set stringlength clr r2 42$: mov HeadTB(r2), r0 beq 46$ call EqlHdr bcc 46$ tst (r2)+ br 42$ 46$: mov r2, HdrIdx 48$: inc NrHdrL mov HdrPrf(r2), r0 mov NrHdrL, r1 mov #LinBuf+1, r1 clr SpcFlg(r5) ; Space flag (Skip leeding spaces). clr BraFlg(r5) movb HdrStr, r0 neg r0 add #LinBuf+RhtLim, r0 cmp #SubTb-HeadTB, r2 ; Don't cut subject line... beq 4805$ tst IsAdrF(r2) beq 49$ 4805$: add #RhtMrg-RhtLim+2, r0 49$: mov r0, AbrLim(r5) 50$: call GetChr bcs 1000$ cmp #Cr, r0 bne 60$ call GetChr bcs 1000$ cmp #Lf, r0 bne 60$ call GetChr ; Was next? bcs 54$ cmp #Spc, r0 ; Doesit continue on next line? beq 55$ ; yes, merge the two lines... cmp #Tab, r0 beq 55$ 54$: dec r4 ; Put it back! Just watching... br 150$ 55$: tst IsAdrF(r2) bne 70$ br 66$ 60$: tst BraFlg(r5) beq 62$ cmp #'), r0 bne 82$ dec BraFlg(r5) br 82$ 62$: cmp #'(, r0 bne 64$ inc BraFlg(r5) br 82$ 64$: tst IsAdrF(r2) ; Is this an address-field? beq 68$ ; No. cmp #',, r0 bne 68$ movb r0, (r1)+ 66$: dec MoreP ; One more af this kind to get! br 150$ 68$: cmp #Spc, r0 ; Space bne 80$ 70$: mov #Spc, r0 inc SpcFlg(r5) ; Space flag bne 100$ br 82$ 80$: cmp #Tab, r0 ; Tab beq 70$ mov #-1, SpcFlg(r5) ; flag = Take next space... 82$: cmp r1, AbrLim(r5) blt 90$ 84$: cmpb #Spc, r0 beq 66$ cmpb #tab, r0 beq 66$ movb r0, -(r4) cmp #LinBuf+30., r1 bhis 66$ movb -(r1), r0 br 84$ 90$: movb r0, (r1)+ cmp r1, #LinBuf+RhtMrg bge 66$ 100$: br 50$ 150$: mov r1, r0 mov #LinBuf, r1 sub r1, r0 dec r0 movb r0, (r1)+ br 700$ 500$: clr r0 clr r2 dec EoHdP ; End of header fields! 700$: tst (pc)+ 1000$: sec 9999$: pop r3 ret ;+ ; GetRce returns group-number in KOM of the receiver to the text. ; Call r1 = Pointer to string. r2 = length. ; Return r0 = Groupnumber or zero. ; r1 = type of group (1 = person, 2 = newsgroup) ;- GetRce: mov r2, r0 beq 100$ ; No receiver here! mov #ToBuff+1, r2 call GtNeAd ; GetNetAddress bcs 100$ push ; Save pointer 10$: movb (r1)+, r2 cmp #'@, r2 beq 20$ cmp #'A, r2 bhi 15$ cmp #'Z, r2 blo 15$ bisb #40, -1(r1) ; Make it lower case 15$: sob r0, 10$ 20$: sub (sp)+, r0 ; Use everything before the "@". neg r0 pop r1 movb r0, -(r1) ; set new length 50$: mov #GrpLst, r0 call FindAd bcs 100$ mov rPri1(r0), r1 mov (r0), r0 br 999$ 100$: clr r0 999$: rts pc ;+ ; GtNeAd - GetNetAddress returns the address stripped from ; spaces and comments. ; Call: r0, r1: Len, pos of line to be converted. ; r2 : Destination string. ; Return: r0, r1: Len, pos of destination string. ; carry set if no address was found at all. ;- GtNeAd: push ; r2 must be top of stack! clr r4 ; () - level. clr r5 ; Inside <> - flag. 10$: movb (r1)+, r3 cmp #'(, r3 bne 20$ inc r4 br 100$ 20$: cmp #'), r3 bne 30$ dec r4 bpl 100$ clr r4 br 100$ 30$: tst r4 ; Are we inside a comment? bne 100$ ; Yes! Goto 100$ cmp #Spc, r3 ; Skip all white-spaces.. beq 100$ cmp #Tab, r3 beq 100$ tst r5 bne 50$ cmp #'<, r3 bne 90$ inc r5 mov (sp), r2 ; Return only whats between the br 100$ ; brackets. 50$: cmp #'>, r3 beq 120$ ; Thats it! 90$: movb r3, (r2)+ 100$: sob r0, 10$ 120$: mov (sp), r1 ; Address of line. mov r2, r0 ; Address to end of line. sub r1, r0 ; Length of line. beq 200$ tst (pc)+ 200$: sec pop rts pc ;+ ; RdLine transfers a line from KIN/FB1/r4 to LinBuf/r1/r2 ; Returns: r1 ponter to 1'st byte in LinBuf ; r2, length of line... ;- RdLine: push r3 mov #FB1+1000, r3 mov #LinBuf+1, r1 clr r2 10$: call GetChr bcs 99$ cmp #Cr, r0 bne 20$ call GetChr bcs 99$ cmp #Lf, r0 beq 30$ 20$: movb r0, (r1)+ inc r2 cmp #RhtMrg, r2 bhis 10$ 30$: mov #LinBuf, r1 movb r2, (r1)+ ; Save length of line clc 99$: pop r3 rts pc GetChr: cmp r4, r3 blo 50$ mov #FB1, r4 gos Get, <#-KIN,,r4,#1,> ; Get next block. bcs 99$ 50$: clr r0 bisb (r4)+, r0 beq GetChr ; Skip Nulls clc 99$: rts pc proc clink var tmprec, word begin call MtxBgn gos getrec <#2, toprec(r5), buffer(r5),> tst 32(r1) ; Any comments already? bne 230$ mov comrec(r5), 32(r1) ; comrec(r5) is current record gos put <#2,,buffer(r5)> br 250$ 230$: mov #2, r0 call release ; Release the lock mov 32(r1), tmprec(r5) gos tryrec <#2, 32(r1), buffer(r5),> mov 30(r1), toprec(r5) mov comrec(r5), 30(r1) tst toprec(r5) bne 233$ mov tmprec(r5), toprec(r5) br 235$ 233$: gos putget <#2, toprec(r5), buffer(r5)> 235$: mov comrec(r5), 26(r1) gos putget <#2, comrec(r5), buffer(r5)> mov toprec(r5), 30(r1) gos put <#2,,buffer(r5)> call MtxEnd 250$: ret WrFiNa: push mov #TmpStr, r2 mov #FqbBuf+FqNam1, r1 mov (r1)+, r0 call r50unp mov (r1)+, r0 call r50unp mov #'., (r2)+ mov (r1)+, r0 call r50unp mov r2, r0 mov #TmpStr, r1 sub r1, r0 call PrintN call pcrlf pop rts pc ;+ ; R50UNP ; Unpack a 3 char RAD50 symbol to ASCII ; ; Enter with R2 -> Output ASCII string ; r0 -> RAD50 symbol to unpack ; ; Return with R2 -> Past output string ; ; Reference to MACRO language Manual for more detailes ;- R50UNP: push mov r0, r4 1$: mov r4, r1 mov #50*50, r3 call 10$ mov #50, r3 call 10$ mov r1, r0 call 11$ pop rts pc 10$: clr r0 div r3, r0 11$: tst r0 beq 23$ cmp r0, #33 blt 22$ beq 21$ add #22-11, r0 21$: add #11-100, r0 22$: add #100-40, r0 23$: add #40, r0 movb r0, (r2)+ rts pc RdLet: tst unrel bne 10$ 5$: jmp 1000$ 10$: mov @unrel, r1 beq 5$ cmp #-1, r1 bne 100$ push #10$ 20$: add #2, unrel mov @unrel, mypoin add #2, unrel rts pc 100$: add #2, unrel cmp #-1, @unrel bne 200$ call 20$ 200$: inc myread mov r1, OldL mov #FB4, CurBlk call MtxBgn gos GetRec, <#2, r1, CurBlk,> mov r1, r5 .date mov xrb, 44(r1) ; Set received-datum... mov xrb+2, 46(r1) gos Put, <#2,, CurBlk> call MtxEnd add #6, r1 call GetDat mov 12(r5), r0 call GetFrm bcc 250$ jmp 1000$ 250$: mov r5, r1 call GetTo ; Get receivers and mark used ; headers. mov r5, r1 call GetIRT mov NrRece, r0 beq 1000$ mov #ToBuff, r4 300$: call OpnNxt movb (r4)+, r0 mov r4, r1 add r0, r4 call PrintN call pcrlf Write #Frm821 mov #From+1, r1 mov NeNaLn, r0 call PrintN mov #Spc, r0 call ttyout Write #Date Write #RmtUFH call pcrlf Write #zDate Write #Date call pcrlf Write #zID mov #TxtNr, r0 mov NrRece, r1 call MakeID call strout call pcrlf mov #zFrom, r1 tst OutTbP ; Do we heve a from-field? beq 310$ mov #zSend, r1 ; Yes, and an sender-field. 310$: call strout Write #From call pcrlf tstb InRpTo beq 330$ tst OutTbP+14 bne 330$ Write #zRepTo Write #InRpTo call pcrlf 330$: Write #zRtPth mov #From+1, r1 mov RtPtLn, r0 call PrintN 340$: mov r5, r1 mov #-1, r0 call DspHd 390$: gos OutTxt, <20(r5), 22(r5), #FB3> bic #UtmOn, KSW call UtmOff 400$: dec NrRece bne 300$ 1000$: rts pc OpnNxt: push mov FileNr, r1 mov #ExtOFl, r2 mov #4, r3 20$: clr r0 div #10., r0 add #'0, r1 movb r1, -(r2) mov r0, r1 sob r3, 20$ 30$: mov #'>, r0 call ttyout mov #StaOFl, r1 mov #AftOFl-StaOFl, r0 call PrintN call pcrlf mov #OutFil, r1 inc FileNr call opnfil bis #UtmOn, KSW pop rts pc ;+ Data passed: R1, The address of a 2-word block containing date in RSTS/E ; internal format. ;- GetDat: push mov (r1)+, firqb+4 mov (r1), firqb+22 movb #uu.cnv, firqb+fqfun mov #-1, firqb+6 ; DD-MON-YY format! mov #1, firqb+24 ; 24-hour time .uuo mov #firqb+10, r1 mov #firqb+21, r0 mov #Date+1, r2 20$: cmpb -(r0), #40 beq 20$ ; Discard trailing spaces sub r1, r0 inc r0 30$: movb (r1)+, r3 cmpb #'-, r3 bne 40$ mov #40, r3 40$: movb r3, (r2)+ sob r0, 30$ movb #40, (r2)+ mov #firqb+26, r1 mov #5, r0 50$: movb (r1)+, (r2)+ sob r0, 50$ mov #METT, r1 movb (r1)+, r0 60$: movb (r1)+, (r2)+ sob r0, 60$ sub #Date+1, r2 movb r2, Date pop rts pc ;+ ; GetTo extracts all receivers (from the To:-, Cc: or Bcc:-field) ; and mark headers that are used in the text. ; Call: r1, pointer to TEXT record in memeory (File 2). ;- GetTo: push mov r1, r5 mov #OutTbP, r2 mov #EoOTbP-OutTbP, r3 5$: clrb (r2)+ ; No Headers yet! sob r3, 5$ bit #xEXT, 14(r1) beq 10$ bit #xEXIN, 14(r1) beq 20$ 10$: jmp 400$ 20$: clr NrRece clrb ToBuff gos opnlin, <#FB3> mov 14(r1), TxtNr bne 40$ tst 16(r1) bne 40$ mov 2(r5), TxtNr mov 4(r5), TxtNr+2 br 50$ 40$: mov 16(r1), TxtNr+2 50$: inc r2 mov #ToBuff, r5 300$: dec r2 beq 400$ gos gtln ; Get next line into TmpStr / r1. clr r0 bisb (r1)+, r0 beq 300$ dec r0 beq 300$ 310$: movb (r1), r4 sub #'A, r4 asl r4 inc OutTbP(r4) movb (r1)+, r4 cmpb #'B, r4 ; a receiver (To:)? beq 320$ cmpb #'D, r4 ; Bcc: beq 320$ cmpb #'J, r4 ; Cc: bne 300$ 320$: inc NrRece push r2 mov #TmpStr, r2 ; It's no problem to use TmpStr call GtNeAd ; as both sorce and destination... pop r2 mov r5, r4 movb r0, (r5)+ beq 350$ 330$: movb (r1)+, (r5)+ sob r0, 330$ 340$: cmpb #',, -1(r5) ; Remove trailing ",". bne 350$ decb (r4) dec r5 350$: dec r2 beq 400$ gos gtln movb (r1)+, r0 beq 350$ dec r0 beq 350$ cmpb #'+, (r1)+ beq 320$ dec r1 br 310$ 400$: pop rts pc ;+ ; MakeID Makes an message-id: Ex. <353656#1@ufh.dynas.se> ; call: r0, pointer to longword ; r1, Number ; Return: r1, point at buffer. ; Destroys TmpStr. May change section in KOMRES ;- MakeID: push ; Must be in this order. mov r1, r3 mov #MesID, r2 push r2 clrb (r2)+ ; This is to be length-byte. movb #'<, (r2)+ mov (r0)+, r1 mov (r0), r0 call Num32 10$: movb (r1)+, (r2)+ sob r0, 10$ movb #'#, (r2)+ mov r3, r1 call Num16 20$: movb (r1)+, (r2)+ sob r0, 20$ mov #LibInf, r1 call GetAdr add #20, r1 movb (r1)+, r0 40$: movb (r1)+, (r2)+ sob r0, 40$ movb #'>, (r2) pop r1 sub r1, r2 movb r2, (r1) pop rts pc ;+ ; GetFrm Creats a from field. ; Call r0, groupnumber. ;- GetFrm: push r2 mov #GrpLst, r1 call FindCm tst r0 beq 377$ gos GetRec, <#1, rArg-rStr(r0), #FB1, #Unlock> add #160, r1 movb (r1)+, r0 beq 377$ mov #-From-1, r2 mov r2, NeNaLn mov r2, RtPtLn neg r2 10$: movb (r1)+, (r2)+ sob r0, 10$ add r2, NeNaln ; Used for From (RFC 821) mov #LibInf, r1 call GetAdr add #20, r1 movb (r1)+, r0 20$: movb (r1)+, (r2)+ sob r0, 20$ add r2, RtPtLn ; Used for return-path movb #40, (r2)+ movb #'(, (r2)+ mov FinPtr, r1 call GetAdr add #rStr, r1 movb (r1)+, r0 30$: movb (r1)+, (r2)+ sob r0, 30$ movb #'), (r2) mov #From, r1 sub r1, r2 movb r2, (r1) tst (pc)+ 377$: sec pop r2 rts pc DspHd: push mov r5, r1 gos opnlin, <#FB3> inc r2 50$: dec r2 ble 80$ call gtln clr r5 bisb (r1)+, r5 beq 50$ cmpb (r1), #'+ bne 55$ mov r4, r0 beq 50$ call pcrlf call SpcOut inc r1 br 70$ 55$: clr r4 bisb (r1)+, r4 cmpb r4, #'Z bne 60$ clr r4 call pcrlf br 70$ 60$: sub #'A, r4 asl r4 62$: mov OutTbl(r4), r1 bne 64$ clr r4 br 50$ 64$: call pcrlf clr r4 bisb (r1), r4 call strout 65$: mov #Tmpstr+2, r1 70$: dec r5 beq 50$ mov r5, r0 call PrintN br 50$ 80$: call pcrlf 99$: pop rts pc proc OutTxt, begin push mov Buf(r5), r1 gos get, <#3, Blk(r5), r1, #1, #Unlock> add Pos(r5),r1 ; Line (down)counter cmp #-1, (r1)+ beq 48$ 42$: Write #Ilfr jmp 377$ 48$: gos GetWrd, cmp #1, r0 bne 42$ gos GetWrd, mov r0, r2 ; # of lines! beq 200$ gos GetLin, push r1 mov #TmpStr, r1 movb (r1)+, r0 beq 80$ push r1 Write #SubjT pop r1 50$: cmpb #':, (r1)+ beq 70$ sob r0, 50$ Write #TmpStr br 75$ 70$: dec r0 call PrintN 75$: call pcrlf 80$: call pcrlf pop r1 br 100$ 90$: gos GetLin, call OutN 100$: sob r2,90$ 200$: tst (pc)+ 377$: sec pop ret OutN: push r1 mov #TmpStr, r1 movb (r1)+, r0 beq 7$ cmpb #'@, (r1) ; [r denna rad ett filnamn? beq 10$ 5$: call PrintN ; Skriv ut raden (eller delen av raden) 7$: call pcrlf br 99$ 10$: inc r1 dec r0 beq 7$ call DispFi 99$: pop r1 rts pc ;+ ; GetIRT finds the In-Reply-To-field. ; r1 must point at TEXT-record in memory. ;- GetIRT: push mov r1, r5 clrb InRpTo bit #xKom, 14(r5) beq 999$ mov 24(r5), r2 ; Commented letter. beq 999$ gos GetRec, <#2, r2, #FB1, #Unlock> cmp #1, (r1) bne 999$ bit #xEXT, 14(r1) beq 999$ bit #xEXIN, 14(r1) beq 999$ gos opnlin, <#FB3> tst r2 beq 999$ 10$: call gtln clr r4 bisb (r1)+, r4 beq 50$ cmpb #'F, (r1)+ ; Message-ID? bne 50$ dec r4 beq 999$ mov #InRpTo, r2 movb r4, (r2)+ 20$: movb (r1)+, (r2)+ sob r4, 20$ br 999$ 50$: sob r2, 10$ 999$: pop rts pc ; Transfer text from KIN-file to file 3 proc xfrtxt, begin push r1 mov hdr(r5), r1 clr r2 bisb (r1)+, r2 5$: movb (r1)+, r0 call PutChr sob r2, 5$ pop r1 call copych ; Copy oe char from KIN/FB2/r1 to mov r0, r2 ; file3/FB4/r4 call copych swab r0 bis r0, r2 ; r2 is the number of lines to copy beq 40$ 10$: call copych ; Copy length byte mov r0, r3 beq 30$ 20$: call copych sob r3, 20$ 30$: sob r2, 10$ 40$: bit #1, r4 ; Odd? beq 50$ call copych 50$: ret ; Copy one char from input to output. return in r0 copych: cmp r1, #FB2+1000 blo 10$ gos get <#-KIN, , r1, #1,> ; C set if EOF bcs 20$ 10$: clr r0 bisb (r1)+, r0 call PutChr 20$: rts pc ; Wildcard open proc wopen begin gos fsscan call filerr bcs 20$ movb #UU.LOK, firqb+fqfun mov idx(r5), firqb+4 ; index # for file in directory .uuo ; do it! cmpb firqb, #5 ; NOSUCH ? bne 10$ ; Nope - skip forward sec br 20$ 10$: call filerr bcs 20$ movb chan(r5), firqb+fqfil ; Calculate channel # times 2 asl firqb+fqfil movb #OPNFQ, firqb+fqfun calfip ; Open it! call filerr call savfqb 20$: ret ; FSSCAN - FSS a file name. Put result in FIRQB proc fsscan begin call clrfqb call clrxrb clr (r1) movb @n(r5), (r1) ; Length of string mov (r1)+, (r1)+ ; " " " mov n(r5), (r1) ; Then the address inc (r1) .fss ret ; CLOSE indicated channel. proc close begin call clrfqb movb ch(r5), firqb+fqfil asl firqb+fqfil calfip ret Proc Rename begin movb #RENFQ, Firqb+FqFun clr Firqb+FqFil mov #-1, Firqb+FqSiz mov Firqb+FqNam1, Firqb+FqNam2 mov Firqb+FqNam1+2, Firqb+FqNam2+2 mov ext(r5), Firqb+FqFlag clr Firqb+FqPFlg calfip call Filerr ret SavFqb: push mov #Firqb, r1 mov #FqbBuf, r2 mov #20, r0 10$: mov (r1)+, (r2)+ sob r0, 10$ pop rts pc RstFqb: push mov #Firqb, r1 mov #FqbBuf, r2 mov #20, r0 10$: mov (r2)+, (r1)+ sob r0, 10$ pop rts pc ; Delete (mark for deletion) the file indicated by firqb contents kill: movb #DLNFQ, firqb+fqfun calfip call Filerr return quit$: jmp $exit IntGrp: .word 0 FileNr: .word 0 NrCrTx: .word 0 NrRece: .word 0 TxtNr: .blkw0 2 MoreP: .word 0 NrLine: .word 0 NrHdrL: .word 0 EoHdP: .word 0 HdrIdx: .word 0 HdrSpc: .word 0 ErrExt: .word 0 NeNaLn: .word 0 RtPtLn: .word 0 FqbBuf: .blkw0 20 SubBuf: Date: .blkb 200 LinBuf: MesId: .blkb 200 From: .blkb 200 SndBuf: InRpTo: .blkb 200 ToBuff: .blkb 2000 HdrStr: .blkb 200 Buff2: .blkb 200 HdrPrf: .word 0 .word 'B .word 0 .word 'D .word 'E .word 'F .word 'G .word 'H .word 'I .word 'J .word 0 ; Sender .word 'K .word 'L .word 'M .word 'N .word 'O .word 'Q .word 'Z IsAdrF: .word -1 ; 'A' .word -1 .word -1 .word -1 .word 0 .word 0 .word -1 ; 'G' .word 0 .word 0 .word -1 ; 'J' .word 0 ; Subject .blkw0 10 HeadTb: .word FrmHdr .word ToHdr .word SndHdr .word BccHdr .word DatHdr .word MIdHdr .word RToHdr .word IRTHdr .word RecHdr .word CcHdr SubTb: .word SubHdr .word RPtHdr .word StaHdr .word RefHdr .word KeyHdr .word OrgHdr .word FolHdr .word 0 OutFil: .byte EoOuFl-StaOFl StaOFl: .ascii "IT0000" ExtOFl: .ascii ".INT" AftOFl: .ascii "/MODE:1024" EoOuFl: Text TXHDR, <<377><377><1><0>> Text XTHDR, <<377><377><2><0><0><0><0><0><0><0><0><0><0><0><0><0>> Text KOMAVS, <"KOM {r f|r tillf{llet avst{ngt."<15><12>> Text WlkMes, <"Internet-server Ver 1.00 "> Text INFILE, <"*.KIN"> Text METT, <" MET"> Text SubjT, <"Subject: "> Text Frm821 <"From "> Text RmtUFH, <" remote from UFH"> Text IlFr, <"?Illigal text-format"> Text MailTo, <"Mail to:"> Text FrmHdr, <"from"> Text ToHdr, <"to"> Text SndHdr, <"sender"> Text BccHdr, <"bcc"> Text DatHdr, <"date"> Text MIdHdr, <"message-id"> Text RToHdr, <"reply-to"> Text IRTHdr, <"in-reply-to"> Text RecHdr, <"receiver"> Text CcHdr, <"cc"> Text SubHdr, <"subject"> Text RefHdr, <"references"> Text OrgHdr, <"organization"> Text KeyHdr, <"keywords"> Text FolHdr, <"followup-to"> Text RPtHdr, <"return-path"> Text StaHdr, <"status"> Text zFrom, <"From: "> Text zTo, <"To: "> Text zSend, <"Sender: "> Text zBcc <"Bcc: "> Text zDate, <"Date: "> Text zId, <"Message-Id: "> Text zRep, <"Reply-To: "> Text zRepTo, <"In-Reply-To: "> Text zRecei, <"Receiver: "> Text zCc, <"Cc: "> Text zRtPth, <"Return-Path: "> Text zStat, <"Status: "> Text zRefer, <"References: "> Text zKeyW, <"Keywords: "> Text zOrg, <"Organization: "> Text zXref, <"Xref: "> Text zFolT, <"Followup-To: "> .even OutTbl: .word zFrom ; 'A' .word zTo ; 'B' .word 0 ; 'C' .word 0 ; 'D' .word 0 ; 'E' .word 0 ; 'F' .word zRep ; 'G' .word zRepTo ; 'H' .word zRecei ; 'I' .word zCc ; 'J' .word zRtPth ; 'K' .word zStat ; 'L' .word zRefer ; 'M' .word zKeyW ; 'N' .word zOrg ; 'O' .word 0 ; 'P' .word 0 ; 'Q' OutTbP: .blkw0 20. EoOTbP: .even EOKOM: .End INIT