home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / k95source / host.ksc < prev    next >
Text File  |  2020-01-01  |  32KB  |  1,127 lines
  1. ; File HOST.KSC - "Host mode" script for K-95.
  2. ;
  3. ; Assumes client is ANSI or VT100 terminal with 24 lines.
  4. ; Protocol operations use APC for automatic up/download,
  5. ; but don't require it.
  6. ;
  7. ;   Works on serial and TCP/IP Telnet connections.
  8. ;   Assumes the connection is already made.  Designed to be
  9. ;   started from HOSTMODE.KSC, which waits for the desired
  10. ;   type of connection to come in.
  11. ;
  12. ; Kermit 95 1.1.3 or later is required.
  13. ;
  14. ; Copyright (C) 1996, 1997, 1998, 1999
  15. ; Trustees of Columbia University in the City of New York.
  16. ; All rights reserved.   Authors:  F. da Cruz, C. Gianone, J. Altman.
  17. ;
  18. ; Version 1.00: February 1996 for 1.1.3.
  19. ; Version 1.01: 8 June 1997 for 1.1.12:
  20. ;  . Add "set transmit echo off".
  21. ;  . Change "clear device-and-input" to "clear input" in GETMENUITEM.
  22. ; Version 1.02:
  23. ;  . Fix problem with requests to send file groups
  24. ; Version 1.03: 9 July 1998 for 1.1.18
  25. ;  . Fix conflict with FAIL command added in 1.1.17
  26. ;  . Fix potential error if _mypriv is non-numeric
  27. ;  . Make sure Autodownload is OFF
  28. ;  . Add SET TELNET REMOTE-ECHO commands
  29. ; Version 1.04 2 September 1999 for 1.1.18
  30. ;  . Disable TELOPT commands
  31. ;  . Add support for Telnet Authentication
  32.  
  33. def _VERSION 1.04 ; Version of this script
  34.  
  35. ; MACRO DEFINITIONS
  36. ;
  37. ; HOSTLOG writes actions to the screen and to the transaction log.
  38. ; See subsequent redefinitions below.
  39. ;
  40. def HOSTLOG echo \v(time) - \fcontents(\%1)
  41.  
  42. ; BOXMSG prints an attention-getting message on the console screen.
  43. ;
  44. def BOXMSG { -
  45.    asg \%9 \frepeat(=,\flen(\%1)), -
  46.    ec \%9, ec \%1, ec \%9, -
  47.    beep -
  48. }
  49.  
  50. ; LOCK and UNLOCK are for use when updating the user database file,
  51. ; to prevent people from writing over each other's changes.
  52. ;
  53. def UNLOCK -
  54.   if not def _locked end 0,-
  55.   if exist \m(_lockfile) delete \m(_lockfile),-
  56.   undef _locked,-
  57.   hostlog {Userfile UNLOCKED},-
  58.   end 0
  59.  
  60. def LOCK -
  61.   if def _locked end 1,-
  62.   if exist \m(_lockfile) end 1,-
  63.   open write \m(_lockfile),-
  64.   if failure end 1,-
  65.   writeln file \m(_username),-
  66.   if failure end 1,-
  67.   close write,-
  68.   if failure end 1,-
  69.   def _locked 1,-
  70.   hostlog {Userfile LOCKED},-
  71.   end 0
  72.  
  73. ; SPLIT and GETFIELDS are for parsing user database records.
  74. ;
  75. def SPLIT -
  76.   asg \%9 \findex(_,\%1),-
  77.   asg _LEFT \fbreak(\%1,_),-
  78.   asg _RIGHT \fsubstr(\%1,\%9+1)
  79.  
  80. def GETFIELDS -
  81.   split {\%1}, -
  82.   asg U_ID \m(_LEFT), -
  83.   split {\m(_RIGHT)}, -
  84.   asg U_PW \m(_LEFT), -
  85.   split {\m(_RIGHT)}, -
  86.   asg U_PR \m(_LEFT), -
  87.   split {\m(_RIGHT)}, -
  88.   asg U_NM \m(_LEFT), -
  89.   split {\m(_RIGHT)}, -
  90.   asg U_AD \m(_LEFT), -
  91.   split {\m(_RIGHT)}, -
  92.   asg U_TP \m(_LEFT), -
  93.   split {\m(_RIGHT)}, -
  94.   asg U_EM \m(_LEFT)
  95.  
  96. ; Make a variable: name is first arg, value is second.
  97. ;
  98. def MAKEVAR2 if def \%2 _assign \%1 \%2, else _assign \%1
  99.  
  100. ; Make a variable from single argument NAME=VALUE
  101. ; Creates variable called "_NAME" with definition "VALUE"
  102. ;
  103. def MAKEVAR -
  104.   if = \findex(=,\%1,1) 0 end, -
  105.   asg \%9 _\freplace(\%1,=,\32), -
  106.   makevar2 \%9
  107.  
  108. ; FAIL handles fatal errors
  109. ;
  110. define FAIL hostlog {In \v(cmdfile) at line \v(_line)...},-
  111.   hostlog {Fatal error \v(errno) \v(errstring) - session closed},-
  112.   beep, exit
  113.  
  114. ; SAVEUSERDB saves the user database
  115. ;
  116. define SAVEUSERDB -
  117.   if exist \fdef(_userbak) del \fdef(_userbak),-
  118.   rename \fdef(_userfile) \fdef(_userbak),-
  119.   if failure hostlog {Warning - Failure to back up user database},-
  120.   open write \fdef(_userfile),-
  121.   xif failure { hostlog {Can't open \fdef(_userfile)}, UNLOCK, end 1 },-
  122.   for \%i 1 \&u[0] 1 { -
  123.     writeln file \&u[\%i], -
  124.     xif failure { -
  125.       hostlog {Error writing record \%i to \fdef(_userfile)},-
  126.       hostlog {Old version preserved as \fdef(_userbak)},-
  127.       break -
  128.     },-
  129.   },-
  130.   close write,-
  131.   asg \%9 \v(status),-
  132.   if not = \%9 0 hostlog {WARNING - Failed to close \fdef(_userfile)},-
  133.   else hostlog {\fdef(_userfile) saved: \&u[0] records},-
  134.   UNLOCK,-
  135.   end \%9
  136.  
  137. ; CONFIGURATION: Defaults in case the config file (HOST.CFG) gets lost...
  138. ;
  139. asg _maxusers 100            ; Maximum number of users in database
  140. asg _inactivity 1800            ; Logged-in inactivity limit (seconds)
  141. asg _logintime 300            ; Inactivity limit while logging in
  142. asg _anonok 1                ; Anonymous logins OK (0 = not OK)
  143. asg _logging 1                ; Logging enabled (0 = skip logging)
  144. asg _dlincoming 0            ; OK to download from INCOMING dir
  145. asg _msgmax 200                ; Longest message size (lines)
  146. asg _protocol kermit            ; Default file transfer protocol
  147. asg _xfermode binary            ; Default file transfer mode
  148. asg _owner THE PROPRIETOR        ; PC owner's name or company
  149. asg _herald Welcome to K-95 Host Mode    ; Main screen title
  150. asg _public   \v(startup)PUBLIC        ; Directory users can get files from
  151. asg _incoming \v(startup)INCOMING    ; Directory that users can send file to
  152. asg _logdir   \v(startup)LOGS        ; Directory for host-mode logs
  153. asg _usertree \v(startup)USERS        ; Root of user directory tree
  154. asg _tmpdir   \v(tmpdir)        ; Directory for temp files
  155. if not def _tmpdir asg _tmpdir \v(startup)TMP
  156. asg _userfile \m(_usertree)/USERS.DAT     ; User database file
  157. asg _greeting \m(_usertree)/GREETING.TXT ; Message/greeting text filename
  158. asg _helpfile \m(_usertree)/HOSTMODE.TXT ; Host-mode help file
  159. asg _msgfile  \m(_usertree)/MESSAGES.TXT ; Messages for proprietor
  160.  
  161. ; Now read the configuration file.
  162. ; Note that the name and subdirectory are hardwired.
  163. ;
  164. asg _configfile \freplace(\v(startup)scripts/host.cfg,/,\\)
  165. asg _mypriv 0
  166.  
  167. if not exist \m(_configfile) forward noconfig
  168. open read \m(_configfile)
  169. if failure forward noconfig
  170. while true { read \%a, if failure break, makevar \%a }
  171.  
  172. :NOCONFIG
  173.  
  174. ; END OF CONFIGURATION SECTION
  175.  
  176. dcl \&u[\m(_maxusers)]
  177.  
  178. if not def _lockfile asg _lockfile \m(_usertree)/USERS.LCK
  179.  
  180. if not exist \m(_userfile)  -
  181.   if not eq "\m(_anonok)" "1" -
  182.     stop 1 Fatal - User database not found and guest logins are disabled.
  183.  
  184. asg _userbak \freplace(\m(_userfile),.DAT,.BAK)    ; Name of backup file
  185.  
  186. ; CD to where the user directories are.
  187. ;
  188. cd \m(_usertree)
  189. if failure stop 1 Fatal - Can't change directory to "\m(_usertree)"
  190.  
  191. ; And then CD to its parent.
  192. ;
  193. cd ..
  194. if failure stop 1 Fatal - Can't change directory to "\m(_usertree)/.."
  195.  
  196. asg _startdir \v(dir)            ; Host-mode "home" directory.
  197.  
  198. ; Create needed directories if they don't exist.
  199. ;
  200. if not directory \m(_incoming) mkdir \m(_incoming)
  201. if not directory \m(_incoming) stop 1 Fatal - no INCOMING directory
  202.  
  203. if not directory \m(_public) mkdir \m(_public)
  204. if not directory \m(_public) stop 1 Fatal - no PUBLIC directory
  205.  
  206. if not directory \m(_usertree) mkdir \m(_usertree)
  207. if not directory \m(_usertree) stop 1 Fatal - no USERS directory
  208.  
  209. if not directory \m(_tmpdir) mkdir \m(_tmpdir)
  210. if not directory \m(_tmpdir) stop 1 Fatal - no TMP directory
  211.  
  212. if eq "\m(_logging)" "1" -
  213.   if not dir \m(_logdir) mkdir \m(_logdir) ; Not fatal if this fails
  214.  
  215. if exist \m(_msgfile) boxmsg {You have messages in \m(_msgfile)!}
  216.  
  217. ; SETTINGS...
  218. ;
  219. set input echo off            ; Keep host PC screen clean
  220. set exit warning off            ; ...
  221. set file display quiet            ; ...
  222. set case off                ; Ignore case in string comparisons 
  223. set delay 1                ; Delay in starting file transfers
  224. set file type binary            ; Transfer mode is binary by default
  225. set transmit prompt 0            ; No line turnaround on TRANSMIT
  226. set transmit linefeed on        ; Keep linefeeds when transmitting
  227. set transmit echo off                   ; No echo during TRANSMIT
  228. set file char cp437            ; For PC-format text files
  229.  
  230. set file names converted        ; No weird stuff in filenames
  231. set receive pathnames off        ; Strip pathnames from incoming files
  232. set send pathnames off            ; and outbound pathnames too
  233. set file collision overwrite        ; Overwrite incoming files by default
  234.  
  235. set input autodownload off
  236. set terminal autodownload off
  237. if >= \v(xversion) 1118 { set telnet remote-echo off }
  238.  
  239. if < \v(xversion) 1118 {
  240.  ; If we are a Telnet server we need to control the echoing ourselves.
  241.  ;
  242.  if not = \findex(tcp,\v(connection),1) 1 forward NOTELOPT
  243.  ;
  244.  ; Ex-post-facto Telnet "negotiations" to undo whatever might have been
  245.  ; negotiated already.  K95 normally is a client, but now it's a server.
  246.  ;
  247.  telopt will echo            ; I must echo
  248.  if failure do fail            ; Make sure this doesn't fail
  249.  telopt dont echo            ; You must not echo
  250.  telopt will sga            ; Suppress Go-Ahead
  251.  telopt wont ttype            ; No terminal type negotiations
  252.  telopt wont naws            ; No screen-size negotiations
  253. }
  254.  
  255. :NOTELOPT
  256. def ERROR msg {\%1}, sleep 2, def _status 1, goto main
  257. def FATAL msg {Fatal - {\%1}}, sleep 2, fail
  258.  
  259. hostlog {\v(date) - Start host script \v(cmdfil)}
  260. hostlog {Current directory: \freplace(\v(dir),\\,/)}
  261.  
  262. ; Macros for screen formatting using VT100/ANSI escape sequences
  263.  
  264. define clr output \27[H\27[2J, if failure do fail   ; Clear screen
  265. define cur output \27[\%1;\%2H, if failure do fail  ; Position the cursor
  266. define atp cur \%1 \%2, out \%3, if failure do fail ; Print text at cursor pos
  267. define cleol out \27[K, if failure do fail          ; Clear to end of line
  268.  
  269. ; Returns basename of DOS/Windows-format filename argument \%1;
  270. ; that is, the filename stripped of disk letter and/or directory path, if any.
  271. ;
  272. define BASENAME -
  273.   asg \%9 \frindex(:,\%1),-
  274.   asg \%8 \frindex(/,\%1),-
  275.   asg \%7 \frindex(\\,\%1),-
  276.   asg \%6 \fmax(\%9,\%8),-
  277.   asg \%6 \fmax(\%7,\%6),-
  278.   return \fsubstr(\%1,\%6+1)
  279.  
  280. ; Print message in message area - line \%M column \%C
  281. define MSG cur \%M \%C, cleol, if def \%1 out \fcont(\%1)
  282.  
  283. ; The next two are used with "Leave a message".
  284. ; \%k is the message line number, global, don't use for anything else.
  285. ;
  286. def ADDLINE incr \%k, asg \&a[\%k] \fcontents(\%1)
  287. def NEWSCREEN def \%L 1, clr
  288.  
  289. ; Erases a character on the input line and from the input variable \%n.
  290. ;
  291. define BS -
  292.   if not > \flen(\%n) 0 end 0,-
  293.   asg \%n \fsubstr(\%n,1,\flen(\%n)-1),-
  294.   decr \%p, out \27[D, cleol, end 0, -
  295.  
  296. ; GETMENUITEM reads a number into \%n, using the echo line, \%L.
  297. ; The argument (\%1) is the label to jump to if the menu needs to be repainted.
  298. ; The minimum value is 1, the maximum value is the second argument, \%2.
  299. ; The prompt is "Enter choice: ".
  300. ;
  301. define GETMENUITEM -
  302.   atp \%L \%C {Enter choice: }, -
  303. :NEW, -
  304.   asg \%p \feval(\%C+14), -
  305.   asg \%q \%p, -
  306.   def \%n, -
  307. :INLOOP, -
  308.   clear input, -
  309.   cur \%L \%p, -
  310.   cleol, -
  311.   input \m(_inactivity),-
  312.   if failure do fail,-
  313.   if eq "" "\v(inchar)" goto inloop, -
  314.   asg \%9 \fcode(\v(inchar)), -
  315.   if  = \%9   9 asg \%9 32, -
  316.   if  = \%9 127 asg \%9 8, -
  317.   if = \%9   8 { bs, goto inloop }, -
  318.   if = \%9  21 { cur \%L \%q, cleol, asg \%p \%q, asg \%n, goto inloop },-
  319.   if  = \%9   3 goto main, -
  320.   if  = \%9  12 goto \%1, -
  321.   if not < \%9 32 forward graphic, -
  322.   if not def \%n goto inloop, -
  323.   forward gotit, -
  324. :GRAPHIC, -
  325.   atp \%L \%p \v(inchar), -
  326.   incr \%p, -
  327.   if eq \%9 32 { if def \%n forward GOTIT, else goto inloop },-
  328.   if not numeric \v(inchar) { msg {"\v(inchar)" - Not a number}, goto new }, -
  329.   if not def \%n asg \%n 0, -
  330.   asg \%n \feval(10 * \%n + \v(inchar)), -
  331.   msg, -
  332.   goto inloop, -
  333. :GOTIT, -
  334.   msg {Your choice: \%n}, -
  335.   if not def \%n goto \%1, -
  336.   if not numeric \%n goto \%1, -
  337.   if > \%n 0 if not > \%n \%2 end 0, -
  338.   msg {\%n - Out of range}, -
  339.   goto new
  340.  
  341. ; INTEXT reads a line of text from user on the input line, \%L, allows editing
  342. ; with Backspace or Del (erase characters), Ctrl-U (erase line), etc.
  343. ; Can be interrupted with Ctrl-C if _ctrlc is defined (it should be defined
  344. ; as a help string to be printed).
  345. ;
  346. ; Terminates on space or any control character except BS, Del, or Ctrl-U.
  347. ; The techniques used for reading and echoing characters are designed to work
  348. ; on both serial and Telnet connections, even whe Telnet echoing is
  349. ; misnegotiated.
  350. ;
  351. ; Argument 1 is the input (echo) line number.
  352. ; Argument 2 is the prompt.
  353. ; Argument 3 is 32 to break on space or less, 31 to break only on control 
  354. ;  chars (use 32 to read a word, use 31 to read a line of text).
  355. ; Argument 4, if included, is the timeout value.
  356. ; Argument 5, if included, is a char to echo in place of what was typed.
  357. ;
  358. ; Returns:
  359. ;   0 on success with \%n set to the text that was input.
  360. ;   1 if Ctrl-C was typed
  361. ;
  362. define INTEXT -
  363.   if not def \%3 asg \%3 32,-
  364.   if not def \%4 asg \%4 \m(_inactivity),-
  365.   if def \%5 if > \flen(\%5) 1 asg \%5 \fsubstr(\%5,1,1),-
  366.   def \%n,-
  367.   asg \%L \%1,-
  368.   asg \%p \feval(\flen(\%2)+\%C),-
  369.   asg \%q \%p,-
  370.   atp \%L \%C {\%2},-
  371.   if def _ctrlc atp \feval(\%L+1) \%C {\m(_ctrlc)},-
  372. :INLOOP,-
  373.   cur \%L \%p, -
  374.   cleol,-
  375.   input \%4,-
  376.   if failure do fail,-
  377.   if eq "\v(inchar)" "" goto inloop,-
  378.   asg \%9 \v(inchar),-
  379.   asg \%8 \fcode(\v(inchar)),-
  380.   if = \%8 3 if def _ctrlc end 1,-
  381.   if = \%8   9 { asg \%8 32, asg \%9 \32 },-
  382.   if = \%8   8 { bs, goto inloop },-
  383.   if = \%8 127 { bs, goto inloop },-
  384.   if = \%8  21 { -
  385.     cur \%L \%q, cleol, asg \%p \%q, asg \%n, goto inloop },-
  386.   if > \%8 \%3 { asg \%n \fcontents(\%n)\fcontents(\%9),-
  387.       if def \%5 atp \%L \%p \%5,-
  388.       else atp \%L \%p \fcont(\%9),-
  389.       incr \%p,-
  390.       goto inloop -
  391.   },-
  392.   if eq "" "\%n" goto inloop,-
  393.   end 0
  394.  
  395. ; Displays a text file on the user's screen
  396. ;
  397. def DISPLAY -
  398.   hostlog {Typing \%1},-
  399.   asg \%9 \v(ftype),-
  400.   set file type text,-
  401.   output \13\10\10,-
  402.   transmit \%1,-
  403.   asg _status \v(status),-
  404.   set file type \%9,-
  405.   out \10\13Use scrollback to view any text that scrolled off the screen.,-
  406.   out \10\13Press any key to continue...,-
  407.   input \m(_inactivity),-
  408.   end 0
  409.  
  410. ;+------------------------------------------------------------------------
  411. ; LOGIN procedure
  412. ;
  413. asg \%C 1     ; Left margin column for login procedure.
  414. asg \%M 6     ; Row for messages.
  415. undef _ctrlc  ; Ctrl-C disabled during login process!
  416. undef _locked
  417.  
  418. hostlog {Connection from \v(line)}
  419. clr
  420.  
  421. atp 1 1 {K-95 Login - Initializing...}
  422.  
  423. if < \v(xversion) 1118 { 
  424.   msleep 2000                ; Wait for TELNET option replies
  425.   clear device-buffer            ; and then clear them out
  426. }
  427.  
  428. hostlog {Auth State = [\v(authstate)]}
  429. hostlog {Auth Name  = [\v(authname)]}
  430. hostlog {Auth Type  = [\v(authtype)]}
  431. hostlog {User name  = [\v(user)]}
  432.  
  433. if eq "\v(authstate)" "valid" {
  434.   asg _username \v(user)
  435.   def ok 0
  436.   if not exist \m(_userfile) forward AUTHBAD
  437.   open read \m(_userfile)
  438.   if failure forward AUTHBAD
  439. :AUTHLOOP
  440.   read \%a
  441.   if failure forward AUTHDONE
  442.   getfields {\%a}
  443.   if not eq "\m(U_ID)" "\m(_username)" goto AUTHLOOP
  444.   def ok 1
  445. :AUTHDONE
  446.   close read
  447.   if > \m(ok) 0 forward AUTHGOOD
  448. :AUTHBAD
  449.   hostlog {Access denied "\m(_username)"}
  450.   undef _password
  451.   if count goto again
  452.   msg {Access denied - hanging up}
  453.   incr \%M
  454.   msg
  455.   hostlog {Invalid user - access denied}
  456.   do fail
  457. :AUTHGOOD
  458.   undef _password
  459.   asg _myname \fdef(U_NM)
  460.   asg _mypriv \m(U_PR)
  461.   if not numeric \m(_mypriv) asg _mypriv 0
  462.   msg {\m(_username) authenticated by \v(authtype)}
  463.   beep
  464.   if >= \v(xversion) 1118 { set telnet remote-echo on }
  465.   undef noecho
  466.   forward LOGGEDIN
  467. }
  468.  
  469. if eq "\v(authstate)" "user" {
  470.   asg _username \v(user)
  471.   forward GETPASSWD
  472. }
  473.  
  474. set count 3                ; Allow three tries to log in
  475. :AGAIN                    ; Login retry loop
  476. clr
  477. atp 1 1 {K-95 Login}
  478. if < \v(count) 3 { msg {Access denied}, sleep 3 }
  479. def \%L 1
  480. define noecho
  481. if >= \v(xversion) 1118 { set telnet remote-echo on }
  482. clear device-buffer            ; Don't allow typeahead
  483. intext 3 {Username: } 32 90
  484. if failure do fail
  485. asg _username \%n
  486. if not eq "\m(_anonok)" "1" forward GETPASSWD
  487. if not eq "\m(_username)" "guest" forward GETPASSWD
  488.  
  489. msg                    ; GUEST user
  490. asg _myname {Anonymous Guest}
  491. asg _mypriv 0
  492. msg
  493. beep
  494. if >= \v(xversion) 1118 { set telnet remote-echo on }
  495. undef noecho
  496. forward LOGGEDIN
  497.  
  498. :GETPASSWD
  499. def noecho on
  500. if >= \v(xversion) 1118 { set telnet remote-echo off }
  501. clear device-buffer
  502. intext 4 {Password: } 32 90 *
  503. if failure do fail
  504. asg _password \f.oox(\%n)
  505. asg \%n
  506.  
  507. :CHECKPASSWD
  508.   def ok 0
  509.   if not exist \m(_userfile) forward BAD
  510.   open read \m(_userfile)
  511.   if failure forward BAD
  512. :PWLOOP
  513.   read \%a
  514.   if failure forward PWDONE
  515.   getfields {\%a}
  516.   if not eq "\m(U_ID)" "\m(_username)" goto PWLOOP
  517.   if not eq "\m(U_PW)" "\m(_password)" goto PWLOOP
  518.   def ok 1
  519. :PWDONE
  520.   close read
  521.   if > \m(ok) 0 forward good
  522. :BAD
  523.   hostlog {Access denied "\m(_username)"}
  524.   undef _password
  525.   if count goto again
  526.   msg {Access denied - hanging up}
  527.   incr \%M
  528.   msg
  529.   hostlog {Incorrect password - access denied}
  530.   do fail
  531. :GOOD
  532.   undef _password
  533.   asg _myname \fdef(U_NM)
  534.   asg _mypriv \m(U_PR)
  535.   if not numeric \m(_mypriv) asg _mypriv 0
  536.   msg
  537.   beep
  538.   if >= \v(xversion) 1118 { set telnet remote-echo on }
  539.   undef noecho
  540.  
  541. ;+------------------------------------------------------------------------+
  542. ; Get here when logged in.
  543.  
  544. :LOGGEDIN
  545.  
  546. ; Create Transaction log with unique name "<username>_<julian-date>_<time>.log"
  547. ;
  548. if eq "\m(_logging)" "1" { -
  549.   log transactions \m(_logdir)/\m(_username)_\v(ndate)_\v(ntime).log, -
  550.   if failure hostlog {Warning - can't create log file},-
  551.   else def HOSTLOG { echo \v(time) - \fcont(\%1),-
  552.     writeln trans \v(time) - \fcont(\%1) } -
  553. }
  554. hostlog {Login by \m(_username) (\m(_myname))}
  555.  
  556. if exist \m(_greeting) display \m(_greeting)
  557.  
  558. :CHKANON ; Check for anonymous GUEST login
  559.   if not eq "\m(_username)" "guest" forward USERCD
  560.   cd \m(_public)
  561.   asg _current PUBLIC
  562.   undef _userdir
  563.   forward START
  564.  
  565. :USERCD ; Create user's directory if necessary and then CD to it.
  566.  
  567. asg _userdir \m(_usertree)/\m(_username)
  568. if not directory \m(_userdir) { -
  569.   hostlog {Creating \m(_userdir)}, -
  570.   mkdir \m(_userdir), -
  571.   if failure fatal {Unable to create your directory} -
  572. }
  573. cd \m(_userdir)
  574. if failure fatal {Unable to access your directory}
  575.  
  576. asg _current USER
  577.  
  578. :START
  579.   dcl \&s[2]            ; Status messages
  580.   def \&s[0] OK
  581.   def \&s[1] FAILED
  582.   def \&s[2] UNKNOWN
  583.  
  584.   dcl \&p[5]            ; Protocol names
  585.   def \&p[1] kermit
  586.   def \&p[2] zmodem
  587.   def \&p[3] ymodem
  588.   def \&p[4] ymodem-g
  589.   def \&p[5] xmodem
  590.  
  591.   define \%C 20 ; Left margin column for menu
  592.   hostlog {Enter main menu}
  593.   undef _csave
  594.   undef _inmail
  595.   undef _status
  596.   set protocol \m(_protocol)
  597.   set file type \m(_xfermode)
  598.  
  599.   def _priv_cd  1
  600.   def _priv_dos 2
  601.   def _idle_limit (none)
  602.   if not numeric _inactivity asg _inactivity 1800
  603.   if > \m(_inactivity) 0 asg _idle_limit \m(_inactivity)
  604.  
  605. :MAIN
  606.   if def _locked unlock
  607.   if def _inmail { hostlog {Message canceled}, undef _inmail }
  608.   dcl \&a[0]
  609.   def _ctrlc (Ctrl-C to return to main menu) ; Ctrl-C enabled now
  610.   if def _csave { asg \%C \m(_csave), def _csave } ; Left margin
  611.  
  612. clr
  613. atp  1 \%C {\m(_herald) V\m(_VERSION)}
  614. atp  3 \%C {Current directory: \freplace(\v(dir),\\,/)}
  615. atp  4 \%C {Protocol: \v(protocol), Transfer mode: \fcaps(\v(ftype))}
  616. if exist \m(_usertree)/\m(_username).MSG -
  617. atp  5 \%C {Message(s) waiting...}
  618. else atp  5 \%C {Idle limit: \m(_idle_limit) sec -- Choices:}
  619. atp  7 \%C { 1 - Change protocol}
  620. atp  8 \%C { 2 - Change transfer mode}
  621. atp  9 \%C { 3 - Change directory}
  622. atp 10 \%C { 4 - List files}
  623. atp 11 \%C { 5 - Download files}
  624. atp 12 \%C { 6 - Upload files}
  625. atp 13 \%C { 7 - View a file}
  626. atp 14 \%C { 8 - Delete files}
  627. atp 15 \%C { 9 - Read messages}
  628. atp 16 \%C {10 - Leave a message}
  629. atp 17 \%C {11 - Change password}
  630. atp 18 \%C {12 - Help}
  631. atp 19 \%C {13 - Logout}
  632. if not > \m(_mypriv) 1 forward NODOS
  633. atp 20 \%C {14 - Execute a DOS command}
  634. if def _status -
  635. atp 24 \%C {Last command: \&s[\m(_status)]}
  636. asg \%H 14             ; Highest menu item
  637. asg \%L 22             ; Menu input line
  638. forward getmenu
  639. :NODOS                 ; DOS commands not allowed
  640. if def _status -
  641. atp 23 \%C {Last command: \&s[\m(_status)]}
  642. asg \%H 13
  643. asg \%L 21
  644. :GETMENU
  645. asg \%M \feval(\%L+1)  ; Message line
  646. getmenuitem main \%H   ; Get user's choice
  647. forward LBL_\%n        ; Go forward and handle it
  648.  
  649. ;+------------------------------------------------------------------------+
  650. ; Host mode actions
  651.  
  652. :LBL_1 ; PROTOCOL
  653. clr
  654. atp  4 \%C {SELECT PROTOCOL}
  655. atp  6 \%C {Current protocol: \v(protocol)}
  656. atp  8 \%C {Choices:}
  657. atp 10 \%C {1 - Kermit}
  658. atp 11 \%C {2 - ZMODEM}
  659. atp 12 \%C {3 - YMODEM}
  660. atp 13 \%C {4 - YMODEM-G}
  661. atp 14 \%C {5 - XMODEM}
  662. atp 15 \%C {6 - Return to main menu}
  663.  
  664. asg \%L 17             ; Menu input line
  665. asg \%M \feval(\%L+2)  ; Message line
  666. getmenuitem lbl_1 6
  667. if not = \%n 6 -
  668.   set protocol \&p[\%n]
  669. asg _status \v(status)
  670. goto main
  671.  
  672. :LBL_2 ; TRANSFER MODE
  673. clr
  674. atp  8 \%C {SELECT TRANSFER MODE}
  675. atp 10 \%C {Current mode: \v(ftype)}
  676. atp 12 \%C {Choices:}
  677. atp 14 \%C {1 - Binary}
  678. atp 15 \%C {2 - Text}
  679. atp 16 \%C {3 - Return to main menu}
  680.  
  681. asg \%L 18             ; Menu input line
  682. asg \%M \feval(\%L+2)  ; Message line
  683. getmenuitem lbl_2 3
  684. if = \%n 1 set file type binary
  685. else if = \%n 2 set file type text
  686. asg _status \v(status)
  687. goto main
  688.  
  689. :LBL_5 ; DOWNLOAD
  690. clr
  691. if > \m(_mypriv) 0 forward DLOK
  692. if eq "\m(_dlincoming)" "1" forward DLOK
  693. if not eq "\m(_current)" "INCOMING" forward DLOK
  694. error {Sorry - Read access to INCOMING directory not allowed.}
  695. :DLOK
  696. atp  4 \%C {DOWNLOAD FILES}
  697. atp  6 \%C {Protocol:      \v(protocol)}
  698. atp  7 \%C {Transfer mode: \v(ftype)}
  699. atp  9 \%C {Type a single file specification.}
  700. if eq "\v(protocol)" "XMODEM" forward DLNAME
  701. atp 11 \%C {To select multiple files:}
  702. atp 12 \%C {include * and/or ? in the filename.}
  703. :DLNAME
  704. intext \%L {File(s) to download: }
  705. if failure goto main
  706. if not def \%n goto main
  707. asg \%n \fexec(basename \%n)
  708. if not > \ffiles(\%n) 0 error {\%n - File not found}
  709. hostlog {Sending \%n}
  710. if eq "\v(protocol)" "kermit" apc receive
  711. msg {Please escape back and initiate a \v(protocol) RECEIVE...}
  712. sleep 1
  713. send \%n
  714. asg _status \v(status)
  715. if = \m(_status) 0 hostlog {Send OK, \v(cps) CPS}
  716. else hostlog {Send failed}
  717. goto main
  718.  
  719. :LBL_6 ; UPLOAD
  720. clr
  721. if > \m(_mypriv) 0 forward UPLOADOK
  722. if not eq "\m(_current)" "PUBLIC" forward UPLOADOK
  723. atp 4 \%C {Sorry - no uploading to the PUBLIC directory.}
  724. atp 5 \%C {Please change to the INCOMING directory or to}
  725. atp 6 \%C {your own home directory prior to uploading.}
  726. sleep 2
  727. asg _status 1
  728. goto main
  729. :UPLOADOK
  730. atp 4 \%C {UPLOAD FILES}
  731. atp 6 \%C {Protocol:      \v(protocol)}
  732. atp 7 \%C {Transfer mode: \v(ftype)}
  733. intext \%L {File(s) to upload: }
  734. if failure goto main
  735. if not def \%n goto main
  736. if not eq "\v(protocol)" "kermit" forward XYZMODEM
  737. apc server
  738. atp 12 \%C {Please escape back and enter SERVER mode...}
  739. sleep 1
  740. beep info
  741. hostlog {Receiving \%n in \freplace(\v(dir),\\,/)}
  742. get \%n
  743. asg _status \v(status)
  744. if = \m(_status) 0 hostlog {Get OK, \v(cps) CPS}
  745. else hostlog {Get failed}
  746. sleep 1
  747. finish
  748. goto main
  749. :XYZMODEM
  750. atp 12 \%C {Please return to your client software and instruct}
  751. atp 13 \%C {it to send \%n using \v(protocol) protocol.}
  752. receive
  753. asg _status \v(status)
  754. goto main
  755.  
  756. :LBL_7 ; TYPE
  757. clr
  758. if > \m(_mypriv) 0 forward TYPEOK
  759. if not eq "\m(_current)" "INCOMING" forward TYPEOK
  760. if eq "\m(_dlincoming)" "1" forward TYPEOK
  761. error {Sorry - Read access to the INCOMING directory not allowed.}
  762. :TYPEOK
  763. atp 8 \%C {TYPE A FILE}
  764. intext \%L {File to type: }
  765. if failure goto main
  766. asg \%n \fexec(basename \%n)
  767. if not exist \%n error {\%n - File not found}
  768. display \%n
  769. goto main
  770.  
  771. :LBL_8 ; DELETE
  772. clr
  773.  
  774. if > \m(_mypriv) 0 forward DELOK
  775. if eq "\m(_current)" "USER" forward DELOK
  776. error {Sorry - You may delete files only in your own directory.}
  777. :DELOK
  778. atp 8 \%C {DELETE FILES}
  779. intext \%L {File(s) to delete: }
  780. if failure goto main
  781. asg \%n \fexec(basename \%n)        ; Strip disk and directory
  782. if not > \ffiles(\%n) 0 error {\%n - Not found}
  783. delete \%n
  784. asg _status \v(status)
  785. goto main
  786.  
  787. :LBL_4 ; DIRECTORY
  788. clr
  789. if > \m(_mypriv) 0 forward DIROK
  790. if eq "\m(_dlincoming)" "1" forward DIROK
  791. if not eq "\m(_current)" "INCOMING" forward DIROK
  792. error {Sorry - Read access to the INCOMING directory not allowed.}
  793. :DIROK
  794. atp  8 \%C {VIEW DIRECTORY LISTING}
  795. hostlog {Sending directory listing}
  796. cur 10 1
  797. asg _tmpfile \m(_tmpdir)K_\v(ntime).TMP
  798. run dir > \freplace(\m(_tmpfile),/,\\)
  799. display \m(_tmpfile)
  800. delete \m(_tmpfile)
  801. goto main
  802.  
  803. :LBL_3 ; CD
  804. clr
  805. atp   8 \%C {CHANGE DIRECTORY}
  806. atp  10 \%C {Current directory: \freplace(\v(dir),\\,/)}
  807. atp  12 \%C {Choices:}
  808. atp  14 \%C {1 - My home directory (read/write only by me)}
  809. atp  15 \%C {2 - The PUBLIC directory (everybody can read it)}
  810. if eq "\m(_dlincoming)" "1" -
  811. atp  16 \%C {3 - The INCOMING directory (everybody can read and write)}
  812. else -
  813. atp  16 \%C {3 - The INCOMING directory (everybody can write)}
  814.  
  815. if > \m(_mypriv) 0 -
  816. atp  17 \%C {4 - A specific directory}
  817. atp  18 \%C {5 - Return to main menu}
  818.  
  819. asg \%L 20             ; Menu input line
  820. asg \%M \feval(\%L+2)  ; Message line
  821.  
  822. getmenuitem LBL_3 5    ; Repaint menu at LBL_3, 5 items in menu
  823. forward cd_\%n         ; Dispatch to chosen menu item
  824.  
  825. :CD_1 ; CD to home directory
  826. if not def _userdir goto main        ; Not for anonymous users
  827. cd \m(_userdir)                ; Real user, CD to own directory
  828. asg _status \v(status)            ; Remember status
  829. enable send                ; Uploads are allowed
  830. set file collision ov            ; OK to overwrite files
  831. asg _current USER
  832. goto main
  833.  
  834. :CD_2 ; CD to PUBLIC directory
  835. cd \m(_public)                ; Everybody can do this
  836. asg _status \v(status)
  837. if < \m(_mypriv) 1 disable send        ; Sending to here not allowed
  838. else enable send
  839. set file collision ov            ; Write over files on uploads
  840. asg _current PUBLIC
  841. goto main
  842.  
  843. :CD_3 ; CD to INCOMING directory
  844. cd \m(_incoming)            ; Everone can come here
  845. asg _status \v(status)
  846. set file collision ov            ; Overwrite files on upload
  847. asg _current INCOMING
  848. enable send                ; It's always OK to upload
  849. goto main
  850.  
  851. ; CD to a given directory.
  852. ; Note the use of \fcontents() to prevent overevaluation of backslashes.
  853. ;
  854. :CD_4 ; CD to a specific directory
  855. if not > \m(_mypriv) 0 error {Sorry - insufficient privilege}
  856. intext \%L {Enter directory name: }
  857. if failure goto LBL_3
  858. if not def \%n goto LBL_3
  859. if not dir \fcont(\%n) error {\%n - not a directory}
  860. cd \fcont(\%n)
  861. asg _status \v(status)
  862. if > \m(_status) 0 error {Failure to change directory to "\fcont(\%n)"}
  863. set file collision backup        ; Overwrite would be dangerous here!
  864. asg _current SPECIAL            ; But RENAME is too confusing...
  865. enable send                ; I'm privileged so I can upload.
  866. goto main
  867.  
  868. :CD_5
  869. goto main
  870.  
  871. :LBL_9 ; CHECK / READ MESSAGES
  872. clr
  873. if not exist \m(_usertree)/\m(_username).MSG forward NOMSGS
  874. display \m(_usertree)/\m(_username).MSG
  875.  
  876. :MSGDISP
  877. clr
  878. atp  8 \%C {MESSAGE DISPOSITION}
  879. atp 10 \%C {Choices:}
  880. atp 12 \%C {1 - Redisplay}
  881. atp 13 \%C {2 - Delete}
  882. atp 14 \%C {3 - Save in MESSAGES.TXT}
  883. atp 15 \%C {4 - Download}
  884. atp 16 \%C {5 - Return to main menu}
  885. asg \%L 18             ; Menu input line
  886. asg \%M \feval(\%L+2)  ; Message line
  887. getmenuitem msgdisp 5
  888. forward MSG_\%n
  889. :MSG_1
  890.   goto lbl_9
  891. :MSG_2
  892.   delete \m(_usertree)/\m(_username).MSG
  893.   asg _status \v(status)
  894.   goto main
  895. :MSG_3
  896.   asg \%9 \freplace(\v(dir),\\,/)
  897.   cd \m(_usertree)
  898.   run copy \m(_username)\\MESSAGES.TXT+\m(_username).MSG -
  899.     \m(_username)\\MESSAGES.TXT
  900.   asg _status \v(status)
  901.   cd \%9
  902.   if = \m(_status) 0 delete \m(_usertree)/\m(_username).MSG
  903.   goto main
  904. :MSG_4
  905.   hostlog {Sending \m(_usertree)/\m(_username).MSG}
  906.   if eq "\v(protocol)" "kermit" apc receive
  907.   msg {Please escape back and initiate a \v(protocol) RECEIVE...}
  908.   asg \%9 \v(ftype)
  909.   set file type text
  910.   sleep 1
  911.   send \m(_usertree)/\m(_username).MSG
  912.   asg _status \v(status)
  913.   set file type \%9
  914.   if = \m(_status) 0 { -
  915.     hostlog {Send OK, \v(cps) CPS}, -
  916.     delete \m(_usertree)/\m(_username).MSG -
  917.   } else { hostlog {Send failed} }
  918. :MSG_5
  919. goto main
  920.  
  921. :NOMSGS
  922. atp 4 \%C {No messages for \m(_username)}
  923. sleep 2
  924. goto main
  925.  
  926. :LBL_10 ; LEAVE A MESSAGE
  927. def _inmail 1
  928. def _ctrlc (Ctrl-C to cancel message)
  929. dcl \&a[\m(_msgmax)+5]
  930. def \%k 0 ; Line number of entire message - see addline
  931.  
  932. clr
  933. addline {Date: \v(date) \v(time)}
  934. addline {From: \m(_username) (\m(_myname))}
  935. atp 4 \%C {LEAVE A MESSAGE FOR \m(_owner)}
  936. asg _csave \%C
  937. def \%C 1
  938. def \%L 6
  939. intext \%L {Subject: } 31
  940. if failure goto main
  941. asg _subject \fcontents(\%n)
  942. addline {Subject: \fcontents(\%n)}
  943. addline {}
  944. cur 7 1
  945. cleol
  946. cur 8 1
  947. cleol
  948. out {Type the message now.  To make a blank line, enter a space by itself.}
  949. cur 9 1
  950. cleol
  951. out {Maximum lines: \m(_msgmax).  Type a period by itself on a line to finish.}
  952. def \%L 10
  953. cur \%L 1
  954. cleol
  955. def \%i 0   ; Line number of message body
  956. set count \m(_msgmax)
  957. :MSGLOOP
  958.   if = \%L 22 newscreen
  959.   incr \%L
  960.   incr \%i
  961.   intext \%L {\flpad(\%i,3,0)> } 31
  962.   if failure goto main
  963.   addline {\fcontents(\%n)}
  964.   if eq "\%n" "." forward msgdone
  965.   if count goto msgloop
  966.   atp %\L 1 {Maximum lines exceeded}
  967. :MSGDONE
  968. incr \%L
  969. cur \%L 1
  970. cleol
  971. incr \%L
  972. if > \%L 22 newscreen
  973. asg \%i 999
  974.  
  975. :MSGCFM ; Confirm the message
  976.   atp \%L 1 {Type Ctrl-C to cancel or Press space bar to send: }
  977.   input \m(_inactivity)
  978.   if failure do fail
  979.   asg \%i \fcode(\v(inchar))
  980.   if = \%i 3 goto main
  981.   if = \%i 32 forward MSGSEND
  982.   goto MSGCFM
  983.  
  984. :MSGSEND ; Send the message
  985. open append \m(_msgfile)
  986. if failure error {Sorry - messages not available now}
  987. for \%i 1 \%k 1 { -
  988.   writeln file \fcontents(\&a[\%i]) -
  989. }
  990. close append
  991. asg _status \v(status)
  992. if = \m(_status) 0 forward MSGOK
  993. hostlog {Problem sending message}
  994. msg {Error sending message}
  995. sleep 2
  996. forward MSGEND
  997.  
  998. :MSGOK
  999. boxmsg {Message from \m(_username): \m(_subject)}
  1000.  
  1001. :MSGEND
  1002. asg \%C \m(_csave)
  1003. undef _csave
  1004. undef _inmail
  1005. goto main
  1006.  
  1007. :LBL_11 ; CHANGE PASSWORD
  1008. clr
  1009. asg \%M 2
  1010. ;
  1011. ; Lock the database.
  1012. ;
  1013. hostlog {User \m(_username) changing password...}
  1014. LOCK
  1015. if failure error {Busy - try again later}
  1016. open read \fdef(_userfile)
  1017. if failure error {Error - try again later}
  1018. undef _myrecord
  1019. asg \&u[0] 0
  1020. ;
  1021. ; Read in the entire database because the whole thing must be written
  1022. ; out again when done.  The user's record number is assigned to _myrecord.
  1023. ;
  1024. for \%i 1 \m(_maxusers) 1 { -
  1025.   read \&u[\%i], -
  1026.   if failure break, -
  1027.   increment \&u[0], -
  1028.   getfields {\&u[\%i]}, -
  1029.   if eq "\m(U_ID)" "\m(_username)" asg _myrecord \%i -
  1030. }
  1031. close read
  1032. if not def _myrecord error {Lookup failure}
  1033. getfields {\&u[\m(_myrecord)]}
  1034.  
  1035. :GETPW
  1036. intext 2 {Old Password:    } 31 \m(_inactivity) *
  1037. if not def \%n goto GETPW
  1038. if not eq "\m(U_PW)" "\f.oox(\%n)" { -
  1039.   unlock,-
  1040.   incr \%M,-
  1041.   error {Sorry.} -
  1042. }
  1043. intext 3 {New Password:    } 31 \m(_inactivity) *
  1044. if failure goto main
  1045. if not def \%n goto GETPW
  1046. asg \%9 \%n
  1047. intext 4 {Retype Password: } 31 \m(_inactivity) *
  1048. if failure goto main
  1049. if eq "\%n" "\%9" forward NEWPWOK
  1050. asg \%M 5
  1051. msg {Passwords do not match - please try again}
  1052. incr \%M
  1053. msg {or use Ctrl-C to return to the main menu.}
  1054. sleep 2
  1055. clr
  1056. goto GETPW
  1057.  
  1058. :NEWPWOK
  1059. asg \&u[\m(_myrecord)] -
  1060. \m(U_ID)_\f.oox(\%n)_\m(U_PR)_\m(U_NM)_\m(U_AD)_\m(U_TP)_\m(U_EM)
  1061. saveuserdb
  1062. if success hostlog {Password changed} 
  1063. else error {FAILED - Password not changed}
  1064. sleep 2
  1065. goto main
  1066.  
  1067. :LBL_12 ; HELP
  1068. clr
  1069. if not exist \m(_helpfile) error {Sorry - no help available}
  1070. display \m(_helpfile)
  1071. goto main
  1072.  
  1073. :LBL_13 ; EXIT
  1074. clr
  1075. hostlog {Close transaction log}
  1076. close transact
  1077. def HOSTLOG echo \v(time) - \%1
  1078. hostlog {Exit host mode}
  1079. atp 2 2 Bye!
  1080. cur 3 1
  1081. cd \m(_startdir)
  1082. hangup
  1083. end 0
  1084.  
  1085. :LBL_14 ; DOS command
  1086. clr
  1087. if not > \m(_mypriv) 1 error {Sorry - insufficient privilege}
  1088. atp  2 \%C {EXECUTE A DOS COMMAND}
  1089. atp  4 \%C {Current directory: \freplace(\v(dir),\\,/)}
  1090. atp  6 \%C {CAUTION: Do NOT issue a command that:}
  1091. atp  8 \%C { 1. Might possibly require input from the PC keyboard.}
  1092. atp  9 \%C { 2. Starts a GUI program.}
  1093. atp 10 \%C { 3. Requires any type of interaction at all.}
  1094. atp 12 \%C {If you do, your session will become stuck and you will}
  1095. atp 13 \%C {have to hang up.  Only give commands that print textual}
  1096. atp 14 \%C {information on a DOS screen and then exit immediately.}
  1097. atp 15 \%C {The output will be displayed on your screen unless you}
  1098. atp 16 \%C {redirect it to a file, in which case you can download or}
  1099. atp 17 \%C {type the file afterwards from the main menu.}
  1100. while true { -
  1101.   intext 19 {DOS Command: } 31,-
  1102.   if failure goto main,-
  1103.   if def \%n break -
  1104. }
  1105. hostlog {DOS command "\fcontents(\%n)"}
  1106. if > \findex(>,\%n) 0 forward DOSREDIR
  1107. ;
  1108. ; Command is not redirected so we redirect it to a temp file
  1109. ; and then display the temp file.  Pipes don't work in Windows 95.
  1110. ;
  1111. asg _tmpfile \m(_tmpdir)K_\v(ntime).TMP
  1112. run \fcontents(\%n) > \freplace(\m(_tmpfile),/,\\)
  1113. ; asg _status \v(status)                ; Doesn't work
  1114. asg _status 2                ; Status is unknown
  1115. if exist \m(_tmpfile) { -
  1116.   display \m(_tmpfile),-
  1117.   delete \m(_tmpfile) -
  1118. }
  1119. goto main
  1120.  
  1121. :DOSREDIR ; Command is already redirected, just run it.
  1122. run \fcontents(\%n)
  1123. asg _status 2
  1124. goto main
  1125.  
  1126. ; End of HOST.KSC
  1127.