rem login.bas rem change ver 9.00: rem level 0 no longer requires password rem qualifier question asked now %nolist rem rem declare all functions rem def fnchk external rem check if already logged integer fnchk fend def fnsup external rem suppress ^@ integer fnsup fend def fncons external rem return console # integer fncons fend def fnbaud external rem get baud rate integer fnbaud fend def fncbbs external rem chain to CBBS integer fncbbs fend def dnload external rem download SENECA.PQT integer dnload fend def fnputi(x$) external rem stash acl, name and logon time integer fnputi fend def fnhalt external rem crash slave (dump caller) integer fnhalt fend def fnstat(x$) external rem write status line integer fnstat fend def fnpurg external rem purge console buffer integer fnpurg fend def fnulog(x%) external rem chain to user area integer fnulog fend rem rem internal functions rem def pwch$(x$) rem check password for valid characters integer i for i=1 to len(x$) if mid$(x$,i,1) < " " or mid$(x$,i,1) > "~" then\ pwch$="" : return next i pwch$=ucase$(x$) fend def getpw$ rem get his password, echo dots string x,y x="" : y=x while x <> chr$(13) x=chr$(inkey) : print "."; if x >= " " then y=y+x wend getpw$=y fend def pdat$(x$)=mid$(x$,3,2)+"/"+right$(x$,2)+"/"+left$(x$,2) rem make MM/DD/YY def ptim$(x$)=left$(x$,2)+":"+mid$(x$,3,2)+":"+right$(x$,2) rem make HH:MM:SS sysname$="SIGI KLUGER" if fnchk = 119 then\ print : print "Error - already logged on";chr$(7) : stop call fnsup on error goto barf dim ac$(9),btbl$(15),actm%(9),qa$(4) data "NEW CALLER",20,"RESTRICTED",10,"",10,"PROBATIONARY",10 data "FULL USER",60,"FULL USER",60 data "",10,"",10,"FULL USER 300",30,"SYSOP",255 data "38400","75","110","134","150","300","600","1200","1800" data "2000","2400","3600","4800","7200","9600","19200" data "COPY","PIP","NSWP","SWEEP" ; qualifier answers for i%=0 to 9 read ac$(i%),actm%(i%) next i% for i%=0 to 15 read btbl$(i%) next i% for i%=1 to 4 read qa$(i%) rem get qualifier answers next i% qq$="Which utility is used to transfer files disk-to-disk " tidt$=date$ : titm$=time$ baud$=btbl$(fnbaud) print : print print "[RTDS (c) 1985 ESKAY]" print "[LOGIN v9.30 - console ";str$(fncons);" - ";baud$;" baud]" print "[";pdat$(tidt$);" - ";ptim$(titm$);"]" print nad$=right$("000"+str$(fncons),3) lcalr$="LASTCALR."+nad$ ufile$="USER"+CHR$(ASC("S")+128)+".SYS" open ufile$ recl 128 as 1 locked curl%=0 get.nam: print : print : call fnpurg input "Please enter your FIRST NAME > "; line fn$ x%=match(";",fn$,1) : if x% <> 0 then\ ln$=mid$(fn$,x%+1,len(fn$)) :\ fn$=left$(fn$,x%-1) : goto nolst input " and your LAST NAME > "; line ln$ nolst: if len(fn$)<2 or len(ln$)<2 or match(" ",fn$+ln$,1) <> 0\ then print "no initials or spaces!" : print : goto get.nam fn$=ucase$(fn$) : ln$=ucase$(ln$) tst$=fn$+ln$ if match("SYSOP",tst$,1) <> 0 then goto creep if fn$="OFF" or ln$="OFF" or fn$="BYE" or ln$="BYE" or\ match("FUCK",tst$,1)<>0 then goto p.o if fn$="HELP" or ln$="HELP" then print:\ print "I want to know your NAME, Mac. If you need":\ print "this much help, call elsewhere!!!" : goto p.o for i%=1 to len(tst$) if mid$(tst$,i%,1) = "}" then curl%=curl%+1 next i% if curl%>4 then print "Connection too noisy - redial" : call fnhalt for i%=1 to len(tst$) if (mid$(tst$,i%,1) < "A") or (mid$(tst$,i%,1) > "z") then\ print "illegal chars in name!" : print : goto get.nam next i% newu% = 0 print : print "looking.."; : dl%=0 read #1, 1; lasthi% : lasthi%=lasthi%+1 : print #1, 1; lasthi% for i%=2 to 250 rem *** first,last,city,acl,date,time,passw,count,default,del/twit ii=i% if ii/10 = int(ii/10) then print "."; read #1, i%; ufn$,uln$,uct$,uac$,udt$,utm$,upw$,ucn$,ulu$,udl$ if ufn$=fn$ and uln$=ln$ and udl$<>"*" then goto found.usr if udl$="*" and dl%=0 then dl%=i% rem *** assume blank names follow valid entries if ufn$=" " then goto exhausted next i% exhausted: if dl%=0 then goto noroom print : print call fnpurg print "You are ";fn$;" ";ln$;", right"; input line yn$ yn$=yn$+"N" : yn$=ucase$(yn$) if left$(yn$,1) <> "Y" then goto get.nam print :print REM *** if baud$="300" then goto barf.300 print "No record found... you must be a new user" newu% = 1 print cfrm: input "Where (city/state) are you calling from ? "; line ct$ ct$=ucase$(ct$) if len(ct$)<3 then goto cfrm pw$=" " goto geqp rem delete this if firsttime caller gets a PW gpwagn: input "I need a password, please... make one up now: ";line pw$ pw$=pwch$(pw$) if pw$="" then\ print chr$(7);"Invalid character entered - redo" : goto gpwagn print "You entered ";pw$;", right"; input line yn$ yn$=yn$+"N" : yn$=ucase$(yn$) if left$(yn$,1) <> "Y" then goto gpwagn geqp: gosub get.eqp twit$=" " gosub qualify print #1, dl%;fn$,ln$,ct$,"0",tidt$,titm$,ucase$(pw$),"1",eqp$,twit$ print if twit$="-" then close 1 : goto denied print "Thanks, you're now in the log." exit: print close 1 call fnputi(uac$+ln$+" "+fn$+chr$(0)) print "You are system caller # ";lasthi% : print rem rem the following code should be un-REMmed if you use CBBS rem rem if end #1 then nos rem open "SUMMARY" as 1 unlocked rem if end #1 then ends rem pt%=0 rem cksum: read #1; n$,l$,d$,f$,t$,s$,p$ rem if t$<>fn$+" "+ln$ then goto cksum rem if l$>"99" then goto cksum rem deleted msg rem if pt%=0 then print "Message(s) waiting in CBBS:" : pt%=1 rem print n$;" from ";f$;" Subj: ";s$ rem goto cksum rem rem nos: lprinter : print "Dummy, set SUMMARY global!!!" : console rem print chr$(7);"CBBS summary unavailable, check manually." rem goto nos1 rem rem the following code scans the PERSONAL.MSG file of RBBS4 rem if end #1 then nos open "PERSONAL.MSG" recl 64 as 1 readonly print "Checking personal mail.."; if end #1 then ends cn$=fn$+" "+ln$ if fn$="SYSOP" then cn$="SYSOP" cnl%=len(cn$) : pt%=0 cksum: read #1; line l$ rem get a line print "."; slines=val(mid$(l$,6,2)) rem get number of lines if slines/2<>int(slines/2) then slines=slines+1 rem make even number if mid$(l$,9,1)="0" then slines=slines+1 : goto cklsl rem skip killed read #1; line l$ rem get TO line if mid$(l$,2,cnl%) = cn$ then goto got.msgs cklsl: read #1; line l$ rem skip to next msg slines=slines-1 if slines=0 then goto cksum else goto cklsl nos: cf$="Dummy, set PERSONAL.MSG global!!!" : gosub wrtcf print chr$(7);"RBBS summary unavailable, check manually." goto nos1 got.msgs: print : print "You have personal mail waiting." pt%=1 ends: close 1 if pt%=0 then\ print:\ print "You have no personal mail, but check RBBS anyway":\ print "for possible announcements or public messages." :\ gosub check.spc nos1: open lcalr$ as 1 locked print using "&"; #1; fn$+","+ln$+","+tidt$+","+titm$+","+uac$ close 1 if not pt% then\ print "Now entering TurboDOS, section NEWSTUFF" xx$=fn$+" "+ln$+" @ "+ptim$(titm$) if newu% = 0 then\ xx$=xx$+" "+uct$+" "+uac$+" "+pdat$(udt$)+"|" :\ xx$=xx$+ptim$(utm$)+" "+ucn$ else\ xx$=xx$+" "+ct$+" (new caller)" xx$=xx$+" "+str$(fncons)+" "+baud$ if len(xx$)>77 then xx$=left$(xx$,77) call fnstat(xx$) cf$=xx$ : gosub wrtcf if newu% then goto prt.new quit: if pt% then\ print : print "Chaining to RBBS...":\ print : call fncbbs stop found.usr: ind%=i% if fn$+" "+ln$ = sysname$ then fn$="SYSOP" : ln$="" upw$=ucase$(upw$) gosub wrback print : print print "Hello again, ";fn$ if udl$="-" then goto twit if ucn$="0" then goto no.1 print "You last called ";pdat$(udt$);" at ";ptim$(utm$) no.1: print "Access level ";uac$;" granted (";ac$(val(uac$));")." print "You have been allotted";actm%(val(uac$)); print "minutes system time." if uac$="0" and val(ucn$)=4 then \ print "After next call, you will be upgraded to ACL 4." ucn=val(ucn$) rem have some fun if ucn=50 then print "GEE, You've called FIFTY times already!":\ goto joked if ucn=100 then print "You've called a bunch of times!!! (100)":\ goto joked if ucn=150 then print "You've called a darn lot of times!!! (150)":\ goto joked if ucn=200 then print "You've called too many times!!! (200)":\ goto joked if ucn<>0 then print "You have called ";ucn$;" time"; :\ if ucn>1 then print "s." else print "." joked: print : print if upw$<>" " then goto get.pw print : print if uac$="0" then gosub pwok : goto exit print "You have no password. Please enter one now (it will echo)." print pwagain: input "Enter NEW password now: ";upw$ upw$=pwch$(upw$) if upw$="" then\ print chr$(7);"Invalid character entered - redo" : goto pwagain print : print gosub pwok : goto exit get.pw: print "Enter your your password :"; : pw$=ucase$(getpw$) : print if pw$=upw$ then gosub pwok : goto exit print "Guess you messed up, try again." mess%=mess%+1 : if mess% <> 3 then goto get.pw print print "You can't be ";fn$;" ";ln$;" or you'd know your password." cf$=fn$+" "+ln$+" "+ptim$(titm$)+" PWG="+pw$ : gosub wrtcf input "Wanna leave a one-liner for the sysop? "; line yn$ if left$(ucase$(yn$+"N"),1)="Y" then\ input ": ";line cf$ : gosub wrtcf print "Down the bit bucket we go now..." xx$="pw violation" goto denied noroom: print : print print "Geewhiz, I'm sorry but the userlog is full." print "You should really try again in a couple of days..." xx$="log full" goto denied barf.300: print : print print "Sorry, new 300 baud callers are no longer accepted." print "Please call back at 1200 baud." xx$="300" goto denied creep: print : print print "Hey, creep, you know you're not the sysop." p.o: print "Get the hell off this system!" xx$="creep" goto denied twit: print : print print "The SYSOP told me to inform you that you can't be" print "accessing this system. Sorry, just following orders..." xx$="twit" goto denied wrback: xcn$=str$(val(ucn$)+1) pwok: print if (val(xcn$)=5) and (uac$="0") and (baud$="300") then xac$="8" if (val(xcn$)=5) and (uac$="0") then xac$="4" else xac$=uac$ if ulu$="res" then gosub get.eqp : ulu$=eqp$ print #1, ind%; ufn$,uln$,uct$,xac$,tidt$,titm$,upw$,xcn$,ulu$,udl$ return prt.new: if end #3 then exit.pr open "NEWCOM" as 3 readonly print : print "CTL-C to abort, CTL-S to freeze" : print prt.lp: read #3; line t$ print t$ if constat% then x%=inkey : if x%=3 then goto exit.pr \ else if x%=19 then x%=inkey goto prt.lp exit.pr: print : print goto quit rem rem ask a qualifier question rem qualify: print : print print "Please answer this simple question if you can...." print "(You must answer correctly on the first try)." qualb: print qq$; input line qaq$ qaq$=pwch$(qaq$) if qaq$="" then goto qualb for i%=1 to 4 if qaq$=qa$(i%) then return next i% print print "Sorry, access has been denied." twit$="-" xx$="UNQUAL" : return rem rem ask for equipment type rem get.eqp: print print "To figure out who uses SENECA, please answer the following" print "questions about your hardware:" print "1 = KAYPRO 2 = OSBORNE 3 = NORTH STAR" print "4 = XEROX 5 = IBM 6 = IBM CLONE" print "7 = TANDY 8 = S-100 9 = OTHER" input "Please enter 1..9 or 0 if not classifyable "; line cc$ if len(cc$) <> 1 then goto get.eqp if cc$<"0" or cc$>"9" then goto get.eqp ge.a: print print "Operating system:" print "1 = CP/M 2.2 3 = CP/M Plus 3 = MP/M" print "4 = MSDOS 5 = TurboDOS 6 = xxNIX" print "7 = other 8 = CP/M-86" input "Please enter 1..8 ";line cy$ if len(cy$) <> 1 then goto ge.a if cy$<"0" or cy$>"9" then goto ge.a eqp$=cc$+cy$ return rem rem the following routine is called after all unsuccessful rem CBBS message checks. Insert your own routine here if rem you need to... rem check.spc: print : return barf: print : print print "Awfully sorry, but an error occurred." print "I'll have to drop you..." print "code : ";err;" /";errl cf$="err "+err+" in line "+str$(errl)+" at "+pdat$(tidt$)+"|"+ptim$(titm$) cf$=cf$+" in LOGIN" : gosub wrtcf xx$="error" denied: xx$=xx$+": "+fn$+" "+ln$+" - "+pdat$(tidt$)+" "+ptim$(titm$) call fnstat(xx$) call fnhalt wrtcf: if end #4 then wrter open "CALLERS.SYS" as 4 if end #4 then wrtit wrtsc: read #4; yn$ goto wrtsc wrtit: print using "&"; #4; cf$ close 4 return wrter: print : print "ERROR -- CALLERS file not found - notify SYSOP" print : return end