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
/
USR.MAC
< prev
next >
Wrap
Text File
|
1987-01-17
|
19KB
|
905 lines
; USR.MAC - 1/17/87 - The MailBox users file.
.z80
maclib TNC.LIB
entry opnusr,clsusr,getusr,updusr,eusr1,eusr2,lstusr,untusr,untusz
entry filusr,conusr,prtcon,rdusr,uslst,uscnt,ufcb,ubfcb,mxusr
entry uspath,ushbbs,usdate,ustime,usmnr,usname,usport,setnam
entry ussetx,usseth
entry usopt,usobbs,usoexp,usoloc,usosys,usoexa,usoexb
entry um1,um2,um3,um4,um5,um6,um7,um8,um9,um9a,um10,um11,um12
entry um13,um14,um15,um16,um17,dname,shpath
external pgst,pghd,pgck,pgdn
external mnr,mcall,ocall,scall,curtime,date,time
external inibak,fcb1,fcb2,fcb3,opt1,opt2,parse,logtxt
external setb7,getbuf,f1l,f1st,f2l,f2st,f3l,f3st
external mtnc,stnc,bindec,numb,@move,@fill,@upper
external wfcb,tobuf,@ntobuf,@closew,@openn
external @outch,@prtx,@cmp,@mcmd,movcal,iscall,erwhat
external @src,@srct,@srcl,@srcn,@srcw,@srcc,@srcf
external ercant,erdone,erexst,erfind,waitc,muldec
external tnca,tncb,addcr0,getcmd,cmd,cmdlen,cmdtyp,$memry
asciictl
bdosdef
tncdefs
dseg
; File control blocks.
ufcb: ds fcbsize
urec equ ufcb+33
ubfcb: ds fcbsize
; User file structure.
; File header record.
; Note that the byte corresponding to usopt MUST be zero.
ushdr:
uscnt: dw 0 ; # users known
usver: db 5 ; File version
usldt: ds 6 ; Date of last compress
usltm: ds 4 ; Time of last compress
uslmnr: ds 2 ; Message number at last compress
uschg: db false ; True if file has changed
rept 112
db 0
endm
; One record per user.
; Bits in usopt are:
usoloc equ 1 ; Local user
usobbs equ 2 ; Is a BBS
usoexp equ 4 ; Is expert user
usodel equ 8 ; Deleted record
usosys equ 10h ; User may become sysop
usoexa equ 20h ; User excluded on port A
usoexb equ 40h ; User excluded on port B
pathl equ 81 ; Max chars in 8 digi + cr + 0
usunul equ 5 ; Unused (yet)
usrec:
uscall: db ' ' ; Users call
usdate: db '000000' ; Date last login
ustime: db '0000' ; Time last login
usmnro equ $-usrec ; Offset to msg number
usmnr: dw 0 ; First msg to see next time
usssid: ds 1 ; SSID most recent connect
uspriv: ds 1 ; Unused now
usname: rept 12
db ' '
endm
usopto equ $-usrec ; Offset to usopt
usopt: ds 1 ; Optional features
usport: ds 1 ; TNC port A or B
uspath: ds pathl ; Path
uslogd: dw 2 ; Count of logins
ushbbs: db ' ' ; Call of users home bbs
usunu: rept usunul
db 0
endm
um1: ds 2
um2: ds 2
um3: ds 2
um4: ds 2
um5: ds 2
um6: ds 2
um7: ds 2
um8: ds 2
um9: ds 2
um9a: ds 2
um10: ds 2
um11: ds 2
um12: ds 2
um13: ds 2
um14: ds 2
um15: ds 2
um16: ds 2
um17: ds 2
dname: ds 2
first: ds 1
uslst: ds 2 ; Address of user calls list
mxusr: ds 2 ; Max users in users list.
ver: ds 1
cnt: ds 2
ptr: ds 2 ; Record number of current user record
cseg
movncr: ld a,(de)
cp cr
ret z
ld (hl),a
inc de
inc hl
dec b
ret z
jr movncr
; Open (or create and open) the user file.
; Allocate memory for user call list.
opnusr: maklst uslst,mxusr,6,' '
dodosa setdma,ushdr
ld hl,ufcb+10
call setb7 ; Set $sys attribute
dodosa open,ufcb
inc a
jr z,opnua
movb ver,usver ; Save current version
dodosa read,ufcb
call fixusr
ld hl,(uscnt)
call bindec
ld hl,(um14)
call @prtx
jr rdlst
opnua: dodosa make,ufcb
call curtime
zmov usldt,date,6
zmov usltm,time,4
zmov uslmnr,mnr,2
; Write the user file header.
; Close and re-open the file.
wtufhs: call wthdr
dodosa close,ufcb
dodosa open,ufcb
ret
wthdr: lxim urec,0
dodosa setdma,ushdr
dodosa wrec,ufcb
ret
; Fill the list of user calls.
rdlst: lxim cnt,0 ; Clear count
movw ptr,uslst ; Point to start of list
dodosa setdma,usrec ; Point I/O to record
rdlsta: ld de,(cnt) ; Got this many
ld hl,(uscnt) ; Need this many
or a ; Clear carry
sbc hl,de ; Got em all?
ret z ; Yes
inc de
ld (cnt),de ; Count this one
ld (urec),de ; Point to rec in file
dodosa rrec,ufcb ; Read the record
ld hl,(ptr) ; Current slot in list
move ,uscall,6 ; Move call to list
ld (ptr),hl ; Next slot
jr rdlsta
; Close the user file.
clsusr: dodosa close,ufcb
ret
; Read the user record for mcall.
; If there is no record, make one.
rdusr: comp mcall,uscall,6 ; Already current?
ret z ; Yes
srclst mcall,uslst,uscnt,6,6
jr nz,rdusra ; New user, make a record for him
ld hl,(@srcf) ; Number of record found
ld (ptr),hl
ld (urec),hl
dodosa setdma,usrec
dodosa rrec,ufcb
ret
; New user. Make a user record for him.
rdusra: call curtime
zmov uscall,mcall,6
zmov usdate,date,6
zmov ustime,time,4
lxim usmnr,0
mvim usssid,'0'
comp mcall,ocall,6 ; Owner's user record?
ld a,usoloc+usobbs+usoexp+usosys
jr z,rdusrb ; Yes
ld a,0
rdusrb: ld hl,usopt
ld (hl),a
fill usname,12,' '
ld de,(dname)
ld hl,usname
ld b,12
call movncr
mvim usport,' '
ld hl,uspath
call addcr0 ; Null string for path
lxim uslogd,0 ; Zero the login count
fill ushbbs,6,' ' ; Blank home bbs
lxim ptr,0 ; Flag for "no user record current"
ld de,(uscnt) ; # users
ld hl,(mxusr) ; Max #
or a ; Clear carry
sbc hl,de ; List full?
ret z ; Yes, leave default
ex de,hl
inc hl ; Count this user
ld (uscnt),hl ; Save new count
ld (ptr),hl ; Point to record
ld (urec),hl ; Point I/O to record
ld de,(@srcl) ; Point to start of list
zmov ,mcall,6 ; Put this user call in list
mvim uschg,true ; Mark file as changed
dodosa setdma,usrec
dodosa wrec,ufcb
jp wtufhs
; Update the current user record with current date,time,last msg.
; Called at logout.
updusr: dtz ptr ; Valid user record?
ret z ; No
ld (urec),hl ; Point I/O at record
call curtime
zmov usdate,date,6
zmov ustime,time,4
movw usmnr,mnr
inxm uslogd ; Count this login
dodosa setdma,usrec
dodosa wrec,ufcb
ret
; Set users name.
setnam: fill usname,12,' '
ld a,(f2l)
cp 13
jr c,setna
ld a,12
setna: ld c,a
ld b,0
ld hl,(f2st)
ld de,usname
ldir
jp erdone
; Connect to user.
; Return zero set if connect fails.
dseg
cmsg: db 'C $U',0
vmsg: db ' v ',0
cseg
; Send connect text to tnc from current user record.
prtcon: ld hl,cmsg
call @prtx
ld a,(usssid)
cp '0'
jr z,prtca
ld c,'-'
call @outch
ld a,(usssid)
ld c,a
call @outch
prtca: ld a,(uspath)
cp cr
jr z,prtcb
ld hl,vmsg
call @prtx
prtcb: ld hl,uspath
jp @prtx
; Connect to the station with call in fcb2.
conusr: srclst fcb2+1,uslst,uscnt,6,6
jr z,cusra
call erfind
retz
cusra: zmov mcall,fcb2+1,6
call rdusr
call tnca
cmpm usport,'B'
jr nz,cusrb
call tncb
cusrb: master
call prtcon
console
zmov mcall,ocall,6
call rdusr
retnz
; Display last path to user.
shpath: srclst fcb2+1,uslst,uscnt,6,6
jp nz,erfind
zmov scall,mcall,6
zmov mcall,fcb2+1,6
call rdusr
ld a,(uspath)
cp cr
jr z,shpa
ld hl,(um13)
cmpm usport,'L' ; Linked user?
jr z,shpc ; Yes
ld hl,(um11)
shpc: call @prtx
ld hl,uspath
call @prtx
jr shpb
shpa: prtx um12
shpb: zmov mcall,scall,6
call rdusr
ret
; Get the user record for mcall, update port and path.
; If there is no record, make one.
getusr: call rdusr ; Read user record
comp mcall,ocall,6 ; Local?
ret z ; Yes, no tnc, ssid, or path
movb usport,logtxt ; TNC id
call parse ; Parse the connect string
ld a,(f1l) ; Length of call+ssid
ld b,a
ld hl,(f1st) ; Location of call
ld a,'-'
gtusra: cp (hl) ; A minus?
inc hl
ld c,(hl) ; ssid
jr z,gtusrb ; Got a ssid
dec b
jr nz,gtusra
ld c,'0' ; No ssid
gtusrb: ld a,c
ld (usssid),a
; Get path
cmpm usport,'L' ; Linked user?
jr nz,zz ; No
zmov uspath,scall,6 ; Call of adjacent node
ld hl,uspath+6
jp addcr0
zz: ld hl,uspath ; Where to put CR,0
ld a,(f3l) ; Length of path string
or a ; Is a path?
jp z,addcr0 ; No
cp pathl-1 ; For CR,0
ret nc ; Path too long
ld c,a
ld b,0 ; Length of path
ld de,(f3st)
move uspath,, ; Get path
jp addcr0 ; Add CR,0 to string
; Edit the user record for user call in fcb2.
getinp: call getcmd ; Get response
ckcmd getinp,getina,getina
ld a,(cmdlen)
or a ; Change?
ret
getina: scf
ret
; Mark current user record as deleted.
delusr: ld a,(usopt) ; Get options
or usodel ; Or in "deleted" bit
ld (usopt),a ; Put options back
mvim uschg,true ; Mark file as changed
ret
eubit: push bc
call @prtx ; Put the prompt
call getinp ; Get response
pop bc
ret c ; Discon/timeout
ret z ; No change
ld a,(usopt)
xor b
ld (usopt),a
ret
; EU (no argument) command. Go through all users and ask delete.
eusr1: zmov scall,mcall,6 ; Save current user
movw cnt,uscnt
mvim shp,pathl ; Show whole path
dodosa setdma,usrec
eusr1a: dtz cnt ; Done?
jp z,eusrz ; Yes
ld (urec),hl
dec hl ; Count this one
ld (cnt),hl
dodosa rrec,ufcb
call lusr
prtx um2
call getinp
jp c,eusrz ; Discon/timeout
ld a,(opt1)
cp 'Q' ; Wants to quit?
jp z,eusrz ; Yes
cp 'Y' ; Delete it?
jr nz,eusr1a
call delusr ; Mark this one as deleted
dodosa wrec,ufcb ; Write changed rec
jr eusr1a
; EU <call> command. Edit a user record.
eusr2: zmov scall,mcall,6 ; Save current user
zmov mcall,fcb2+1,6 ; Who to edit
call rdusr ; Get that rec in, or make one
dtz ptr ; Got one?
jr nz,xx ; Yes
call ercant ; User file full, can't make new
jp eusrz
xx: prtx um1 ; Print header
mvim shp,pathl ; Show whole path
call lusr ; Print it
prtx um2 ; Ask delete
call getinp ; Get response
jp c,eusrz ; Discon/timeout
ld a,(opt1)
cp 'Q' ; Quit?
jp z,eusrz ; Yes
cp 'Y' ; Delete?
jr nz,eusra ; No
call delusr ; Mark this one as deleted
jp eusry ; Clean up
eusra: ld hl,(um15) ; Change expert user state?
ld b,usoexp
call eubit ; Get response
jp c,eusrz ; Discon/timeout
ld hl,(um9a) ; Change is a bbs state?
ld b,usobbs
call eubit ; Get response
jp c,eusrz ; Discon/timeout
ld hl,(um4) ; Change sysop state?
ld b,usosys
call eubit ; Get response
jp c,eusrz ; Discon/timeout
ld hl,(um16) ; Change exclude on A state?
ld b,usoexa
call eubit ; Get response
jp c,eusrz ; Discon/timeout
ld hl,(um17) ; Change exclude on B state?
ld b,usoexb
call eubit ; Get response
jp c,eusrz ; Discon/timeout
prtx um3 ; Change call?
call getinp ; Get response
jp c,eusrz ; Discon/timeout
jr z,eusrc ; No change
srclst uscall,uslst,uscnt,6,6
jr nz,eusrb ; No find (can't happen...)
zmov @srcl,fcb1+1,6 ; New call
eusrb: zmov uscall,fcb1+1,6 ; New call
eusrc: prtx um10 ; Change ssid?
call getinp ; Get response
jp c,eusrz ; Discon/timeout
jr z,eusrd ; No change
movb usssid,opt1 ; New ssid
eusrd: prtx um5 ; Change name?
call getinp ; Get response
jp c,eusrz ; Discon/timeout
jr z,eusrf ; No change
fill usname,12,' ' ; Clear it
movcmd usname,0,12 ; New name
eusrf: prtx um7 ; Change port?
call getinp ; Get response
jp c,eusrz ; Discon/timeout
jr z,eusrg ; No change
movb usport,fcb1+1 ; New port
eusrg: prtx um8 ; Change path?
call getinp ; Get response
jr c,eusrz ; Discon/timeout
jr z,eusri ; No change
ld a,(cmdlen)
ld c,a
ld hl,cmd
call @upper
ld hl,uspath
cmpm cmd,' ' ; Single space?
jr z,eusrh ; Yes, no path
movcmd ,0,pathl-2 ; New path
eusrh: call addcr0 ; Add CR,0 to string
eusri: prtx um9 ; Change home bbs?
call getinp ; Get response
jr c,eusrz ; Discon/timeout
jr z,eusry ; No change
zmov ushbbs,fcb1+1,6
comp ushbbs,ocall,6 ; This is home?
ld a,(usopt)
jr nz,eusrj ; No
or usoloc
jr eusrk
eusrj: cpl
or usoloc
cpl
eusrk: ld (usopt),a
eusry: movw urec,ptr ; Point to record
dodosa setdma,usrec
dodosa wrec,ufcb ; Write changed rec
call wthdr
prtx um1 ; Print header
call lusr ; Print user record
eusrz: zmov mcall,scall,6 ; Restore current call
call rdusr ; and make record current
jp waitc
; Routine to let user flip his own "expert" bit.
ussetx: ld a, (usopt) ; Change bit in user option byte
xor usoexp
ld (usopt),a
jp erdone
; Routine to let user set his own "home bbs" field
dseg
ttcall: ds 6
cseg
usseth: fill ttcall,6,' '
ld hl, (f2st) ; Copy arg from here
ld de, ttcall ; to this temp
ld a, (f2l) ; Only this many chars
call movcal ; Stripping any SSID
ld hl, ttcall ; Check for valid BBS call
call iscall
jp c, erwhat ; If not, don't do it
zmov ushbbs,ttcall,6
comp ushbbs,ocall,6
ld a, (usopt) ; Set local-user bit appropriately
jr nz, ushnl ; Go if not local
or usoloc ; Say local
jr ush9
ushnl: cpl
or usoloc ; Say not local
cpl
ush9: ld (usopt),a ; Store local/not local bit
jp erdone
; FB and FL command - make a file with bbs / local users.
filusr: openwn fcb2
jp z,erexst
movw cnt,uscnt
fusra: dtz cnt ; Done?
jr nz,fusrb ; No
ld c,eof
call tobuf
closew
jp rdusr ; Get right user record back
fusrb: ld (urec),hl
dec hl ; Count this one
ld (cnt),hl
dodosa setdma,usrec
dodosa rrec,ufcb
ld b,usobbs
cmpm opt2,'B'
jr z,fusrc
ld b,usoloc
fusrc: ld a,(usopt)
and b
jr z,fusra
ntobuf uscall,6
ld c,' '
call tobuf
ntobuf usname,12
ld c,cr
call tobuf
ld c,lf
call tobuf
jr fusra
; List the user records.
dseg
shp: ds 1 ; # chars of path to print
cseg
lstusr: movw cnt,uscnt
mvim shp,21 ; Dont show whole path
ld hl,(um1) ; Address of header
call pgst ; Init screen paging
dodosa setdma,usrec
lusra: dtz cnt ; Any left?
jr nz,lusrb ; Yes
call pgdn
jp rdusr ; Make his user record current
lusrb: ld (urec),hl
dec hl ; Count this one
ld (cnt),hl
dodosa rrec,ufcb
ld a,(opt2)
cp 'B' ; Show bbs only?
jr nz,p1 ; No
ld a,(usopt)
and usobbs ; BBS?
jr nz,p9 ; Yes, show it
jr lusra
p1: cp 'L' ; Show locals only?
jr nz,p2 ; No
ld a,(usopt)
and usoloc ; Local?
jr nz,p9 ; Yes, show it
jr lusra
p2: cp 'S' ; Show sysops only?
jr nz,p3 ; No
ld a,(usopt)
and usosys
jr nz,p9
jr lusra
p3: cp 'E' ; Show excluded only?
jr nz,p9 ; No
ld a,(usopt)
and usoexa+usoexb
jr z,lusra
p9: call pghd
call lusr
call pgck
jr nz,lusra ; No pause
ld a,c
cp etx ; Wants to quit?
jp z,rdusr ; Yes, make his user record current
jr lusra
lusr: ld hl,($memry)
move ,uscall,6
ld (hl),' '
inc hl
move ,usdate,6
ld (hl),' '
inc hl
move ,ustime,4
push hl
ld hl,(uslogd)
call bindec
pop hl
move ,numb,5
push hl
ld hl,(usmnr)
call bindec
pop hl
move ,numb,5
ld (hl),' '
inc hl
move ,ushbbs,6
ld (hl),' '
inc hl
ld a,(usssid)
ld (hl),a
inc hl
ld c,usosys
call pyn
ld c,usoloc
call pyn
ld c,usoexp
call pyn
ld c,usobbs
call pyn
ld c,usodel
call pyn
ld c,usoexa
call pyn
ld c,usoexb
call pyn
ld a,(usport)
ld (hl),a
inc hl
ld (hl),' '
inc hl
move ,usname,12
ld de,uspath
ld a,(shp)
ld b,a
call movncr
call addcr0 ; Add CR,0 to string
ld hl,($memry)
jp @prtx
pyn: ld b,'N'
ld a,(usopt)
and c
jr z,pyna
ld b,'Y'
pyna: ld (hl),b
inc hl
ret
; Untangle the user file. Remove deleted users.
dseg
copbs: ds 2
copbp: ds 2
copbc: ds 2
copin: ds 2
oct: ds 2
ict: ds 2
uuzf: ds 1
cseg
; Read a bunch of sectors into buffer
copr: movw copbp,$memry ; Point to start of buffer space
movw copbc,copbs ; Init avail buffer count
lxim copin,0 ; Init count of records read
copra: ld de,(copbp)
dodosa setdma ; Point IO to buffer
dodosa read,fcb3 ; Read text record
dcxm ict ; Count one read
ld a, (uuzf) ; Want to zero the msg numbers?
or a
jr z, copr5 ; Go if not
ld hl, (copbp) ; Yes. Find msg number slot
ld de, usmnro
add hl, de ; ..
ld (hl),0 ; Clear it
inc hl
ld (hl),0 ; Both bytes
copr5: ld hl,(copbp)
ld de,usopto
add hl,de
ld a,(hl)
and usodel ; Deleted?
jr nz,coprb ; Yes, read next
inxm copin ; Count records in buffer
ld hl,(copbp)
ld de,128
add hl,de
ld (copbp),hl ; Point to next buffer
dcxm copbc ; One less available
ld a,l
or h ; Any left
ret z ; No, done with bunch
coprb: dtz ict ; Any left in file?
jr nz,copra ; Yes, read next
ret
; Write the bunch of records.
copw: movw copbp,$memry
copwa: dtz copin ; More to do?
ret z ; No
dec hl
ld (copin),hl
ld de,(copbp)
dodosa setdma
dodosa write,fcb2 ; Write record
inxm oct ; Count one written
ld hl,(copbp)
ld de,128
add hl,de
ld (copbp),hl
jr copwa
untusz: ld a, 1 ; Here to clear msg number during untusr
jr untusb
untusr: cmpm uschg,true ; Any new or deleted?
ret nz ; No
ld a, 0
untusb: ld (uuzf),a ; Flag whether or not to clear msg numbers
dtz uscnt ; Any in the file?
ret z ; No
prtx um6 ; Tell untangling
ld hl,(uscnt) ; # user records
inc hl ; Plus one for header
ld (ict),hl ; Is number to copy
lxim oct,0 ; Init # copied
zmov fcb2,ufcb,fcbsize
zmov fcb3,ubfcb,fcbsize
call inibak ; Initialize files for backup
ret z ; Didn't work
call getbuf ; Get # sectors free mem avail
ld (copbs),hl
; Copy the file.
unta: call copr ; Read a bunch
call copw ; Write em
dtz ict ; Done?
jr nz,unta ; No
dodosa close,fcb2
dodosa open,ufcb ; Open under correct fcb
ld hl,(oct) ; # records written
dec hl ; Minus one
ld (uscnt),hl ; Is current # users
call curtime
zmov usldt,date,6
zmov usltm,time,4
movw uslmnr,mnr
mvim uschg,false
call wthdr
call rdlst ; Re-build the list
jp rdusr ; Make local user current and return
; Update user file to current version.
fixusr: ld a,(ver)
ld hl,usver
cp (hl)
ret z
dtz uscnt ; Any in the file?
jp z,fixz ; No
lxim ict,0 ; Input rec #
dodosa setdma,usrec
fixa: inxm ict ; Next input rec
ld (urec),hl ; Point to input rec
dodosa rrec,ufcb ; Read it
ld a,(usver)
cp 3 ; Version 3 file?
jr z,fixd ; Yes
cp 4 ; Version 4 file?
jr z,fixf ; Yes
; Fixes for version 1 or 2
ld hl,uspath
ld c,pathl-2
fixb: ld a,(hl)
or a
jr z,fixc
cp ' '
jr z,fixc
cp cr
jr z,fixc
inc hl
dec c
jr nz,fixb
fixc: call addcr0 ; Add CR,0 to string
ld hl,usssid
ld a,(hl)
cp ' '
jr nz,fixd
ld (hl),'0'
; Change for version 3->4
fixd: lxim uslogd,1 ; Start login count at one
ld a,(usopt)
and usoloc ; Local user?
jr nz,fixe ; Yes
fill ushbbs,6,' ' ; Blank fill home bbs
jr fixf
fixe: zmov ushbbs,ocall,6
; Change for version 4->5
fixf: ld hl,uspriv ; Old priv type
ld a,(hl)
ld (hl),0 ; Now unused
ld b,usosys
cp 'S' ; Sysop?
jr z,fixg ; Yes
ld b,usoexa
cp 'A' ; Excluded A?
jr z,fixg ; Yes
ld b,usoexb
cp 'B' ; Excluded B?
jr z,fixg ; Yes
ld b,usoexa+usoexb
cp 'E' ; Excluded both?
jr nz,fixy ; No, nothing to do
fixg: ld a,(usopt)
xor b
ld (usopt),a
fixy: movw urec,ict ; Point to output rec
dodosa wrec,ufcb ; Write it
ld hl,(ict) ; # we did
ld de,(uscnt) ; # to do
or a ; Clear carry
sbc hl,de ; Did em all?
jp nz,fixa ; No
fixz: movb usver,ver
jp wthdr
end