home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PACKET / RLI120.ARK / FWD.MAC < prev    next >
Text File  |  1987-05-11  |  10KB  |  487 lines
  1. ; FWD.MAC - 5/11/87 - Auto-forwarding of messages.
  2. ; Thank you K4NTA for the code to handle GATOR 2 PAD
  3. ; connections (H forwarding).
  4.  
  5.     .z80
  6.     maclib    TNC.LIB
  7.  
  8.     entry    fwd1,fwd2,fwd3,fwd4,chgf,ffcb,kilfwd,fstay,mm7
  9.  
  10.     external    mlhd,mhprev,mhcur,mmhs,mhnr,mhtype,mhstat,mhto
  11.     external    mhbbs,mhtit,mhtitl
  12.  
  13.     external    wthdr,kmsg,getto,ucalls,uccnt,prtmsg
  14.     external    change,curtime,firmsg,mfcb,mrec,mfhs
  15.     external    ckname,ername,erdone,parse,flds,fcb1,fcb2,opt2
  16.     external    eofs,leofs,dis,twotnc,@wait
  17.     external    ocall,mcon,mtnc,stnc
  18.     external    log,event,logtxt,llogtxt
  19.     external    decbin,bindec,numb,@fill,@mcmd,@cmpcmd
  20.     external    gotreq,tnca,tncb,@openr,rdcmd,fmbuf,rfcb
  21.     external    @outch,cmdtnc,@docmd,wtcmd,@prtx,@upper,@cmp,@cmpwc
  22.     external    @src,@srct,@srcl,@srcn,@srcw,@srcc
  23.     external    addcr0,getdat,cmd,cmdlen,cmdtyp,gotcon,$memry
  24.  
  25.     asciictl
  26.     bdosdef
  27.     tncdefs
  28.     timdef
  29.  
  30.     dseg
  31. tmhpr:    ds    2
  32. kilfwd:    ds    1        ; True if ok to kill msg after forward
  33. fstay:    ds    1        ; True if F type msgs not killed
  34. frcfwd:    ds    1        ; True to ignore hour spec
  35. onebbs:    ds    1        ; True if forward only 1 MailBox
  36. fwm1:    db    'S  $G',0
  37. fwm2:    db    ' @ $A',0
  38. fwm3:    db    ' < $P',0
  39. mm7:    ds    2
  40. dofrom:    ds    1
  41. tcall:    ds    6
  42. fcall:    ds    8        ; Only to this MailBox
  43.  
  44. ; File control block, filled by RDPARAM.
  45.  
  46. ffcb:    ds    fcbsize
  47.  
  48. ; Stuff for GATOR 2 PAD
  49.  
  50. ispad:    ds    1        ; Forward to GATOR 2 PAD
  51.  
  52.     cseg
  53.  
  54. ; In all those cases of disconnect, etc. just return to caller,
  55. ; caller can inspect cmdtyp to find out what happened.
  56. ; Return zero cleared - general "No good" status.
  57.  
  58. badret:    retnz
  59.  
  60. chgf:    ckname    fcb2
  61.     jp    z,ername
  62.     zmov    ffcb,fcb2,fcbsize
  63.     jp    erdone
  64.  
  65. ; Check if the current time is between the given start/end times.
  66. ; Return zero set if ok.
  67.  
  68. cktime:    fill    numb,5,' '
  69.     movw    numb,cmd+2    ; Not before
  70.     call    decbin
  71.     push    hl        ; Save start time
  72.     movw    numb,cmd+4    ; Not after
  73.     call    decbin
  74.     ld    c,l        ; End hour
  75.     pop    hl
  76.     ld    b,l        ; Start hour
  77.     ld    a,(hr)
  78.     ld    d,a        ; Current hour
  79.     ld    a,c
  80.     cp    b        ; End - start
  81.     jr    z,c3
  82.     jr    c,c2
  83.  
  84. ; Start hr < end hr.
  85.  
  86.     ld    a,d        ; Current hour
  87.     cp    b
  88.     ret    c        ; Zero cleared
  89.     ld    a,c
  90.     cp    d
  91.     ret    c        ; Zero cleared
  92. go:    retz
  93.  
  94. ; Start hour > end hour
  95.  
  96. c2:    ld    a,d
  97.     cp    b
  98.     jr    nc,go
  99.     ld    a,c
  100.     cp    d
  101.     jr    nc,go
  102. no:    retnz
  103.  
  104. ; Start and end the same
  105.  
  106. c3:    ld    a,d
  107.     cp    b
  108.     ret
  109.  
  110. ; Read a line and convert to upper case.
  111.  
  112. rdcmdu:    call    rdcmd
  113.     ret    z        ; EOF or ERR
  114.     call    parse
  115.     retnz
  116.  
  117. ; Auto-forwarding.
  118.  
  119. fwd1:    mvim    onebbs,false
  120.     mvim    frcfwd,false
  121.     jr    fwda
  122. fwd2:    mvim    onebbs,true
  123.     mvim    frcfwd,false
  124.     jr    fwd
  125. fwd3:    mvim    onebbs,false
  126.     mvim    frcfwd,true
  127.     jr    fwda
  128. fwd4:    mvim    onebbs,true
  129.     mvim    frcfwd,true
  130. fwd:    zmov    fcall,fcb2+1,8    ; Save call + SSID
  131. fwda:    mvim    ispad,false    ; Assume NOT a GATOR 2 PAD
  132.     ld    hl,frcfwd
  133.     ld    (hl),true    ; Assume ignore times
  134.     ld    a,(opt2)
  135.     cp    'I'        ; Ignore times?
  136.     jr    z,fwdb        ; Yes
  137.     ld    (hl),false    ; Honor times
  138. fwdb:    openr    ffcb        ; Open FWD.TNC
  139.     ret    z        ; No file, no forward
  140.     mvim    event,'M'
  141.     ld    hl,logtxt
  142.     ld    (hl),'F'
  143.     inc    hl
  144.     ld    (hl),' '
  145.     mvim    logtxt+7,' '
  146.     ld    hl,change
  147.     ld    a,(hl)
  148.     ld    (hl),false    ; Will be up to date
  149.     cp    true        ; Is it?
  150.     call    z,getto        ; Update, if not current
  151.  
  152. ; Read the next command or list header.
  153.  
  154. fwdc:    call    rdcmdu
  155.     jr    z,fwdd        ; EOF or ERR
  156.     ld    hl,fwdc        ; Return address
  157.     push    hl        ; Onto stack for return
  158.     ld    a,(fcb1+1)    ; Command
  159.     cp    'U'
  160.     jp    z,fwdi
  161.     cp    'F'
  162.     jp    z,dofwd
  163.     cp    'G'
  164.     jp    z,dofwd
  165.     cp    'H'
  166.     jr    z,dopadh
  167.     cp    'P'
  168.     jr    z,dopar
  169.     ret            ; and get next list header
  170.  
  171. ; H type forwarding - a GATOR 2 PAD.
  172.  
  173. dopadh:    mvim    ispad,true    ; Thru a PAD
  174.     ld    hl,($memry)    ; Use free memory and
  175.     movcmd    ,1,cmdmax    ; save string to send to PAD
  176.     jp    addcr0        ; Add CR,0 at end of string, return
  177.  
  178. ; Finished the file of forwarding instructions.
  179. ; Clean up and return to caller.
  180.  
  181. fwdd:    call    tnca
  182.     console
  183.     mvim    gotreq,false    ; Ignore any connect req
  184.     cmpm    change,true    ; Any messages killed?
  185.     call    z,wthdr        ; If yes, write hdr back
  186.     ret
  187.  
  188. ; Set tnc parameters.
  189.  
  190. dopar:    ld    a,(fcb1+2)    ; TNC ID
  191.     cp    'B'
  192.     jr    z,dopara
  193.     call    tnca
  194.     jr    doparc
  195. dopara:    cmpm    twotnc,false
  196.     jp    z,fwdi
  197.     call    tncb
  198. doparc:    call    rdcmdu        ; Get TNC command from file
  199.     jr    z,dopard    ; EOF or ERR
  200.     cmpcmd    eofs,leofs
  201.     jr    z,dopard    ; End of command group
  202.     ld    hl,($memry)
  203.     movcmd    ,0,cmdmax
  204.     call    addcr0        ; Put CR,0 at end of string
  205.     docmd    $memry
  206.     jr    doparc
  207. dopard:    console
  208.     mvim    ispad,false
  209.     ret
  210.  
  211. ; Forward messages to another MailBox.
  212. ; Example: FA2207C K1BC via KA1CB
  213. ; Function, TNC ID, Not before, Not after, Connect path.
  214.  
  215. dofwd:    cmpm    onebbs,true    ; Forward to one MailBox only?
  216.     jr    nz,dofx        ; No, do all
  217.     comp    fcall,fcb2+1,8    ; This one?
  218.     jp    nz,fwdi        ; No, try next MailBox
  219. dofx:    movcmd    logtxt+8,6,llogtxt-10
  220.     call    addcr0        ; Put CR,0 at end of string
  221.     ld    a,(fcb1+2)    ; TNC ID
  222.     cp    'B'
  223.     jr    z,dofa
  224.     call    tnca
  225.     jr    dofb
  226. dofa:    cmpm    twotnc,false
  227.     jp    z,fwdi        ; No B TNC, try next MailBox
  228.     call    tncb
  229. dofb:    console
  230.     ld    hl,dofrom
  231.     ld    (hl),false    ; Assume old style
  232.     ld    a,(fcb1+1)    ; F or G
  233.     cp    'F'        ; Old style?
  234.     jr    z,dofc        ; Yes
  235.     ld    (hl),true    ; New type, add "< FROM"
  236. dofc:    cmpm    frcfwd,true    ; Ignore hours?
  237.     jr    z,dofd        ; Yup, do it now
  238.     call    cktime        ; Can we do it at this time?
  239.     jp    nz,fwdi        ; No
  240.  
  241. ; Read call of person whose messages should be forwarded.
  242.  
  243. dofd:    call    rdcmdu
  244.     jp    z,fwddis
  245.     cmpcmd    eofs,leofs    ; Done with this MailBox?
  246.     jp    z,fwddis    ; Yes, disconnect.
  247.     cmpm    fcb1+1,'*'    ; Forward ALL?
  248.     jr    z,dofe        ; Yes
  249. ; Any mail for this person? (Allow wildcards in fwd file entry)
  250.     srclsw    fcb1+1,ucalls,uccnt,6,6
  251.     jr    z,doff        ; Yes, forward
  252. ; Any mail for this bbs? (Allow wildcards in fwd file entry)
  253.     zmov    tcall,fcb1+1,6
  254.     ld    a,(tcall)
  255.     or    80h
  256.     ld    (tcall),a
  257.     srclsw    tcall,ucalls,uccnt,6,6
  258.     jr    z,doff        ; Yes, forward
  259.     jp    dofd        ; No, try next call
  260.  
  261. ; Forward all
  262.  
  263. dofe:    ld    a,(uccnt)    ; # calls with unread mail
  264.     or    a
  265.     jp    z,dofd        ; Nothing to forward
  266.     dec    a        ; Only one call in list?
  267.     jr    nz,doff        ; More than one, forward
  268.     srclst    ocall,ucalls,uccnt,6,6
  269.     jp    z,dofd        ; Keep mail for owner only here
  270.  
  271. ; Forward mail for call in fcb1+1.
  272.  
  273. doff:    master
  274.     call    fmsg        ; Forward the messages
  275.     console
  276.     jp    z,dofd        ; That one went, try next
  277.     call    fwddis        ; No go. Disconnect from MailBox
  278.     wait    4        ; For any I frames to drain from TNC.
  279.  
  280. ; Ignore the rest of this list by reading to "*** EOF".
  281.  
  282. fwdi:    console
  283.     mvim    ispad,false
  284.     call    rdcmd
  285.     ret    z
  286.     cmpcmd    eofs,leofs
  287.     ret    z
  288.     jr    fwdi
  289.  
  290. ; Disconnect from the MailBox we are connected to.
  291.  
  292. fwddis:    mvim    ispad,false
  293.     cmpm    mcon,false
  294.     ret    z        ; Not connected
  295.     master
  296.     call    cmdtnc
  297.     call    dis
  298.     ld    a,false
  299.     ld    (mcon),a
  300.     console
  301.     ret
  302.  
  303. ; Eat the menu. Return zero set for ok, cleared if discon/timeout.
  304.  
  305. eat:    call    getdat
  306.     ckcmd    eat,badret,badret
  307.     ld    a,(cmdlen)
  308.     or    a
  309.     jr    z,eat
  310.     dec    a
  311.     ld    e,a
  312.     ld    d,0
  313.     ld    hl,cmd
  314.     add    hl,de
  315.     ld    a,(hl)
  316.     cp    '>'
  317.     ret    z
  318.     jr    eat
  319.  
  320. ; Connect to another MailBox.
  321. ; Return zero set for success, cleared for failure.
  322.  
  323. cmb:    ld    hl,logtxt+8
  324.     prtx
  325.     call    wtcmd
  326.     ret    nz
  327.  
  328. ; Wait for response from MailBox
  329.  
  330. cmba:    call    getdat
  331.     ckcmd    cmba,cmbe,cmbf
  332.     call    gotcon
  333.     jr    nz,cmba
  334.  
  335. ; Wait for answer from PAD, if H forwarding.
  336.  
  337.     cmpm    ispad,true    ; Is it a PAD?
  338.     jr    nz,cmbd        ; No
  339.     ld    c,cr        ; Send a packet to the PAD,
  340.     call    @outch        ; so it knows we level 2
  341. cmbb:    call    getdat        ; Get line from PAD
  342.     ckcmd    cmbb,cmbf,cmbf
  343.     call    gotpad        ; Got PAD's msg?
  344.     jr    nz,cmbb        ; No, get another line
  345.     prtx    $memry        ; Send the BBS call to the PAD
  346.  
  347. ; Wait for msg from PAD.
  348.  
  349. cmbc:    call    getdat
  350.     ckcmd    cmbc,cmbf,cmbf
  351.     call    gotrst        ; PAD reset msg?
  352.     call    z,eat        ; Eat the extra line
  353.     jr    z,cmbd        ; Means PAD connected ok
  354.     jr    cmbf        ; Failed, no connect
  355.  
  356. ; Connect worked, expect logon msg and menu. Eat them.
  357.  
  358. cmbd:    call    eat
  359.     ret    z        ; Got a '>'
  360.     jr    cmbf
  361.  
  362. ; Connect failed
  363.  
  364. cmbe:    call    wtcmd
  365.     retnz
  366.  
  367. ; Connect timed out.
  368.  
  369. cmbf:    call    cmdtnc
  370.     call    dis
  371.     mvim    ispad,false    ; Just to be sure
  372.     retnz
  373.  
  374. ; Find PAD's msg.
  375.  
  376. gotpad:    cmpcmd    padto,lpadto
  377.     ret
  378.  
  379. ; Find PAD reset msg.
  380.  
  381. gotrst:    cmpcmd    padrst,lpadrst
  382.     ret
  383.  
  384. ; The PAD msgs.
  385.  
  386. padto:    db    'enter: call [,digi1 [,digi2 [,digi3] ] ]'
  387. lpadto    equ    $-padto
  388.  
  389. padrst:    db    'to?*** pad: connection reset'
  390. lpadrst    equ    $-padrst
  391.  
  392. ; Forward all messages addressed to fcb1+1.
  393. ; Return zero set for ok, cleared if lost connection, or failed connect.
  394.  
  395. fmsg:    mvim    firmsg,false
  396.     movw    mhcur,mlhd    ; Point to last hdr
  397. fmsga:    dtz    mhcur
  398.     ret    z
  399.     movw    mrec,mhcur
  400.     dodosa    setdma,mmhs
  401.     dodosa    rrec,mfcb
  402.     movw    tmhpr,mhprev    ; Save pointer to previous header
  403.     cmpm    mhstat,'N'    ; Already read or forwarded?
  404.     jp    nz,fmsgk    ; Yes
  405.     comp    mhbbs,ocall,6    ; It says to keep here?
  406.     jp    z,fmsgk        ; Yes
  407.     cmpm    fcb1+1,'*'    ; Forward ALL?
  408.     jr    nz,fmsgb    ; No
  409.     comp    mhto,ocall,6    ; For owner?
  410.     jp    z,fmsgk        ; Yes, don't forward
  411.     jr    fmsgd        ; No, forward it
  412.  
  413. fmsgb:    cmpm    mhbbs,' '    ; MailBox specified?
  414.     jr    z,fmsgc        ; No
  415.     compwc    mhbbs,fcb1+1,6    ; To this MailBox?
  416.     jr    z,fmsgd        ; Yes, forward it
  417.     jp    fmsgk        ; No
  418.  
  419. fmsgc:    compwc    mhto,fcb1+1,6    ; To this person at this MailBox?
  420.     jp    nz,fmsgk    ; No
  421. ; Ok, forward this msg to this MailBox.
  422. fmsgd:    cmpm    mcon,true    ; We connected?
  423.     call    nz,cmb        ; No, Attempt connect
  424.     ret    nz        ; No connect
  425.     mvim    mcon,true    ; We are now connected
  426.     movb    fwm1+1,mhtype
  427.     ld    hl,fwm1
  428.     call    @prtx        ; Send "Sx TO"
  429.     ld    hl,fwm2
  430.     cmpm    mhbbs,' '
  431.     call    nz,@prtx    ; Send " @ BBS"
  432.     ld    hl,fwm3
  433.     cmpm    dofrom,true    ; Put the FROM call in?
  434.     call    z,@prtx        ; Send " < FROM"
  435.     ld    c,cr
  436.     call    @outch
  437. ; Send TITLE
  438.     ld    hl,mhtit
  439.     ld    b,mhtitl
  440. fmsge:    ld    a,(hl)
  441.     cp    cr
  442.     jr    z,fmsgf
  443.     ld    c,a
  444.     call    @outch
  445.     inc    hl
  446.     dec    b
  447.     jr    nz,fmsge
  448. fmsgf:    ld    c,cr
  449.     call    @outch
  450. ; Eat the "Enter title..." and "Enter message..." prompts.
  451. fmsgg:    call    getdat
  452.     ckcmd    fmsgg,badret,badret
  453. fmsgh:    call    getdat
  454.     ckcmd    fmsgh,badret,badret
  455.     call    curtime
  456.     prtx    mm7
  457.     call    prtmsg        ; Send the msg
  458.     ld    c,eof
  459.     call    @outch
  460.     ld    c,cr
  461.     call    @outch
  462.     call    eat
  463.     ret    nz
  464.     ld    hl,(mhnr)
  465.     call    bindec
  466.     zmov    logtxt+2,numb,5
  467.     call    log
  468.     cmpm    kilfwd,false        ; Kill msg after forward?
  469.     jr    z,fmsgi            ; No, just mark it
  470.     cmpm    fstay,true        ; 'F' msgs stay here?
  471.     jr    nz,fmsgj        ; No, kill it
  472.     cmpm    mhtype,'F'        ; Message type F?
  473.     jr    z,fmsgi            ; Yes, don't kill it
  474. fmsgj:    call    kmsg
  475.     jr    fmsgk
  476.  
  477. fmsgi:    mvim    mhstat,'F'
  478.     movw    mrec,mhcur
  479.     dodosa    setdma,mmhs
  480.     dodosa    wrec,mfcb
  481.     mvim    change,true
  482. fmsgk:    movw    mhcur,tmhpr
  483.     jp    fmsga
  484.  
  485.     end
  486. 
  487.