! FTP Utilities for using VAX/VMS from EMAS.
! Must be compiled PARM FREE with the IMP80 compiler

%const %string (1) SNL = "
"
%systemroutinespec OUTFILE(%string(31) NAME,
   %integer LEN, MAX, PROT, %integername CONAD, FLAG)
%record %format RF (%integer CONAD, FILETYPE, DATA START, DATA END)
%system %routine %spec CONNECT (%string(31) S,
   %integer ACCESS, MAXBYTES, PROT, %record(rf)%name R, %integername FLAG)
%system %string (255) %fn %spec FAILURE MESSAGE (%integer FLAG)
%system %routine %spec PSYSMES (%integer ROOT, FLAG)
%external %routine %spec LIST (%string (255) PARM)
%external %routine %spec TRANSFER (%string (255) PARM)
%external %routine %spec PROMPT (%string(63) PSTR)
%external %routine %spec SETMODE (%string(255) MODES)
%external %routine %spec DEFINE (%string(255) PARM)
%external %routine %spec CLEAR (%string (255) ALL)
%external %routine %spec ASSIGN (%string (255) PARM)
%external %string (255) %fn %spec TRANSLATE (%string (255) STR)
%external %string (255) %fn %spec UINFS (%integer I)
%external %integer %fn %spec OUTPOS

%const %string (7) DEFAULT VAX = "ECSVAX", LOGICAL VAX = "VAX_VAX"
%own %string (7) VAX = "ECSVAX"
%const %integer USER NAME = 1, SUR NAME = 7, EMAS TYPE = 10
%own %string (31) PROGRAM = "VAXUTILS"

%routine MAKE UPPER (%string (*) %name S)
   %integer I
   %for I = 1, 1, LENGTH(S) %cycle
      CHARNO(S,I) = CHARNO(S,I) - 'a' + 'A' %if 'a' <= CHARNO(S,I) <= 'z'
   %repeat
%end

%routine FAIL (%string (255) REASON)
   SELECT OUTPUT (0)
   PRINT STRING (PROGRAM." fails - ".REASON)
   NEWLINE
   %stop
%end

%routine READ STRING (%string (*) %name ST)
   %integer I
   ST = ""
   SKIP SYMBOL %while NEXT SYMBOL = NL %or NEXT SYMBOL = ' '
   %cycle
      READ SYMBOL (I)
      %exit %if I = NL
      ST = ST.TO STRING (I)
   %repeat
%end

%routine READ UC STRING (%string(*)%name S)
   READ STRING (S)
   MAKE UPPER (S)
%end

%string(15) %fn MAKE VAX FILE (%string(127) EMAS)
   %string(63) EXT

   %if EMAS -> (".").EMAS %start; %finish; ! Strip user
   %if EMAS -> ("_").EMAS %start; %finish; ! No PD file names
   EXT = "" %unless EMAS -> EMAS.("#").EXT
   LENGTH(EXT)  = 3 %if LENGTH(EXT)>3
   LENGTH(EMAS) = 9 %if LENGTH(EMAS)>9
   EMAS = EMAS.".".EXT %if EXT#""
   %result = EMAS
%end

%string(19) %fn make fs file(%string(127) emas)
   %string(63) ext

   %if emas -> (".").emas %start; %finish
   %if emas -> ("_").emas %start; %finish
   ext = "" %unless emas -> emas.("#").ext
   emas = emas.".".ext %if ext # ""
   length(emas) = 19 %if length(emas) > 19
   %result = emas
%end

%routine READ SILENT (%string(63) prom, %string (*) %name PASS)
   SET MODE ("ECHO=OFF")
   PROMPT (prom)
   %if NEXT SYMBOL=NL %start
       PASS = ""
       SKIP SYMBOL
   %else
       READ STRING (PASS)
   %finish
   SET MODE ("ECHO=ON")
   NEWLINE
%end

%routine DO COPY (%integer IG1,IG2)
   %integer CH, LAST NL, NL COUNT
   %on %event 9 %start
       %return
   %finish

   LAST NL = 1; ! TRUE
   NL COUNT = 0
   %cycle
      READ CH (CH)
      %SIGNAL 9 %IF CH = 25
      %if LAST NL = 1 %and CH=IG1 %and NEXT SYMBOL = IG2 %start
          READ SYMBOL (CH) %until CH = NL
          %return
      %finish
      PRINT CH (CH)
      LAST NL = 0
      LAST NL = 1 %if CH = NL
   %repeat
%end

%external %routine SET VAX (%string (255) PARM)
   PROGRAM = "SETVAX"
   FAIL ("Unknown VAX name '".PARM."'") %unless PARM="ERCVAX" %or PARM="ECSVAX"
   ASSIGN (PARM.",VAX_VAX")
%end

%external %routine VAXJOB (%string (255) PARM)
   %string (127) USER, NAME,  PASS
   %record (RF) R
   %integer I, FLAG

   %on 9 %start; %return; %finish

   PROGRAM = "VAXJOB"
   VAX = TRANSLATE (LOGICAL VAX)
   VAX = DEFAULT VAX %if VAX=LOGICAL VAX

   %if PARM#"" %start
       MAKE UPPER (PARM)
       CONNECT (PARM, 0, 0, 0, r, flag)
       PSYSMES (8, FLAG) %and %stop %if FLAG # 0
       FAIL ("Wrong file type") %unless r_filetype=3
   %else
       DEFINE ("1,T#JOB")
   %finish

   SELECT INPUT (0)
   SELECT OUTPUT (0)
   PROMPT ("VAX user: ")
   READ UC STRING (USER)
   FAIL ("Invalid VAX username '".USER."'") %if LENGTH(USER)>12
   READ SILENT ("Vax pass: ", PASS)
   PROMPT ("Job name: ")
   READ UC STRING (NAME)

   ! Now read the file (if it does not exist).
   %if PARM="" %start
       PARM = "T#JOB"
       SELECT OUTPUT (1)
       PROMPT ("Job text: ")
       DO COPY ('*',NL)
       NEWLINE
       SELECT OUTPUT (0)
       CLOSE STREAM (1)
       CLEAR ("1")
   %finish

   TRANSFER (PARM.",".VAX."(".USER.",".PASS.")".NAME.",JOB,FAILMAIL")
   PRINT STRING ("Job queued for ".VAX)
   NEWLINE
%end

%routine details(%string(255) s, %string(11) computer,
                 %string(255)%name user, pass, file, newfile)
%string (255) a, b
prompt("Emas filename: ")
%if s # "" %then make upper(s) %else read uc string(s)
%unless s -> file.(",").user %start
   prompt(computer." user: ")
   read uc string(user)
   User = b."/FS=".a %if User -> a.("::").b
   file = s
%finish
read silent(computer." pass: ", pass) %unless user -> user.(",").pass
%if pass#"" %and charno(pass, 1) = ',' %start
   newfile = substring(pass, 2, length(pass))
   length(newfile) = length(pass)-1
   read silent(computer." pass: ", pass)
%finish %else %start
   newfile = "" %unless pass -> pass.(",").newfile
   Prompt (computer." file: ")
   read uc string (newfile) %if newfile=""
%finish
FAIL (computer." user name too long '".user."'") %if %c
   (computer="Vax" %and length(user)>12) %or (computer="FS" %and length(user)>6)
%end

%routine background(%string(*)%name bpass)
print string("Please type your Emas background password");   newline
read silent("Pass: ", bpass)
! Ideally, a check should be done here
%end

%routine check emas file(%string(63) file)
%integer flag, i
outfile(file, 0, 0, 0, i, flag);   ! Force Director failure if all else is OK
fail(failure message(flag)) %if flag # 0 %and flag <= 500;   ! Pragmatism !!
%end

%routine vax imply(%string(255) file, %string(255)%name newfile)
%string(63) dev, dir, ext, type
%if newfile -> dev.(":").newfile %then dev = dev.":" %else dev = ""
%if newfile -> dir.("]").newfile %then dir = dir."]" %else %start
   %if newfile -> dir.(">").newfile %then dir = dir.">" %else dir = ""
%finish
%if newfile -> newfile.("-").type %then type = "-".type %else type = ""
%if newfile -> newfile.(".").ext %then ext = ".".ext %else ext = ""
newfile = make vax file(file) %if newfile = "" = ext
newfile = dev.dir.newfile.ext.type
%end

%externalroutine TOVAX (%string(255) s)
   %string(255) USER, PASS, FILE, NEWFILE
   %record (RF) R
   %integer FLAG

   %on 9 %start; %return; %finish

   PROGRAM = "TOVAX"
   VAX = TRANSLATE (LOGICAL VAX)
   VAX = DEFAULT VAX %if VAX=LOGICAL VAX

   details(s, "Vax", user, pass, file, newfile)
   vax imply(file, newfile)
   connect (file, 0, 0, 0, r, flag)
   psysmes (8, flag) %and %stop %if flag#0
   FILE = UINFS(1).".".FILE %unless FILE -> (".")

   TRANSFER (FILE.",".VAX."(".USER.",".PASS.")".NEWFILE.","."FILE,FAILMAIL")

   NEWFILE = "SYS$LOGIN:".NEWFILE %unless NEWFILE -> (":") %or NEWFILE -> ("]")
   NEWFILE = NEWFILE.".;" %unless NEWFILE -> (".")
   NEWFILE = NEWFILE.";" %unless NEWFILE -> (";")
   PRINT STRING (FILE." will be copied to ".VAX."::".NEWFILE)
   NEWLINE
%end

%externalroutine FROMVAX (%string(255) s)
   %string(255) user, pass, file, newfile

   %on 9 %start; %return; %finish

   PROGRAM = "FROMVAX"
   VAX = TRANSLATE (LOGICAL VAX)
   VAX = DEFAULT VAX %if VAX=LOGICAL VAX

   details(s, "Vax", user, pass, file, newfile)
   check emas file(file)
   vax imply(file, newfile)

   TRANSFER (VAX."(".USER.",".PASS.")".NEWFILE.",".FILE.",FILE,FAILMAIL")

   file = uinfs(1).".".file %unless file -> (".")
   newfile = "SYS$LOGIN:".newfile %unless newfile -> (":") %or newfile -> ("]")
   newfile = newfile.".;" %unless newfile -> (".")
   newfile = newfile.";" %unless newfile -> (";")
   print string(vax."::".newfile." will be copied to ".file)
   newline
%end

%external %routine NETPRINT (%string (255) PARM)
print string ("The commands OPPRINT or MHPRINT must be used instead of NETPRINT")
newline
%end

%external %routine OPPRINT (%string (255) PARM)
   %string (255) USER
   %record (RF) R
   %integer FLAG

   %on 9 %start; %return; %finish

   PROGRAM = "OPPRINT"
   connect (parm, 0, 0, 0, r, flag)
   psysmes (8, flag) %and %stop %if flag#0

   USER = UINFS (1)
   %if SUBSTRING(USER,1, 2) # "EC" %start
       Printstring ("OPPRINT is only for use by Edinburgh Computer Science users");   NEWLINE
       Printstring ("although the listing is being sent this time!");   NEWLINE
   %finish
   TRANSFER (PARM.",ECSVAX(NETFS,UNTYPEABLE)DR3:[OPSPOOL]".USER.".LIS,FILE,FAILMAIL")
%end

%external %routine MHPRINT (%string (255) PARM)
   %string (255) USER
   %record (RF) R
   %integer FLAG

   %on 9 %start; %return; %finish

   PROGRAM = "MHPRINT"
   connect (parm, 0, 0, 0, r, flag)
   psysmes (8, flag) %and %stop %if flag#0

   USER = UINFS (1)
   %if SUBSTRING(USER,1, 2) # "EC" %start
       Printstring ("MHPRINT is only for use by Edinburgh Computer Science users");   NEWLINE
       Printstring ("although the listing is being sent this time!");   NEWLINE
   %finish
   TRANSFER (PARM.",ECSVAX(NETFS,UNTYPEABLE)DR3:[MHSPOOL]".USER.".LIS,FILE,FAILMAIL")
%end

%externalroutine tofs(%string(255) s)
   %string(255) user, pass, file, newfile, filestore
   %record (rf) r
   %integer flag

   %on 9 %start; %return; %finish

   program = "TOFS"
   details(s, "FS", user, pass,file, newfile)
   newfile = make fs file(file) %if newfile = ""
   newfile = newfile."." %unless newfile -> (".")
   filestore = "" %unless newfile -> Filestore.("::").newfile
   filestore = "B" %if filestore=""

   connect (file, 0, 0, 0, r, flag)
   psysmes (8, flag) %and %stop %if flag#0

   define ("1,T#TOFS")
   define ("2,".FILE)
   select input (2)
   select output (1)
   print string ("
$on error then goto fail
$on severe then goto fail
$on warning then goto fail
$create netscratch:".newfile."
$deck
")
   %cycle
      READ CH (FLAG)
      %exit %if FLAG=25
      PRINT CH (FLAG)
   %repeat
   NEWLINE %if OUTPOS>1
   print string ("$eod
$tofs/user=".user."/fs=".filestore." netscratch:".newfile."
".pass."
$delete netscratch:".newfile.";
$logout
$fail:proc:='f$process()'
$len='f$length(proc)'
$name:=""NETSCRATCH:''f$extract(1,len,proc)'.TXT;""
$open/write ef 'name")
   print string ("
$write ef ""Error using TOFS for
$write ef ""   Username  : ".user)
   print string ("
$write ef ""   Password  : ".pass)
   print string ("
$write ef ""   Filename  : ".newfile)
   print string ("
$write ef ""   Filestore : ".filestore)
   print string ("
$close ef
$mail_ 'name ".UINFS(10)."::".uinfs(1)." /subj=""File transfer from Emas to ECS filestore""
$delete_ 'name
")
   select input (0)
   select output (0)
   close stream (1)
   close stream (2)
   CLEAR ("1,2")

   TRANSFER ("T#TOFS,ECSVAX(NETFS,UNTYPEABLE),JOB,FAILMAIL")
   file = uinfs(1).".".file %unless file -> (".")
   newfile = user.":".newfile %unless newfile -> (":")
   newfile = filestore."::".newfile
   print string(file." will be copied to ".newfile." on the EUCSD ethernet")
   newline
%end

%externalroutine fromfs(%string(255) s)
   %string(255) user, pass, bpass, file, newfile

   %string (15) %fn MACHINE
      %string (255) MC
      MC = uinfs (10)
      ! Map to VAX FTP names
      MC = "EMAS" %if MC = "2976"
      MC = "BUSH" %if MC = "2988"
      %result = MC
   %end
   
   %on 9 %start; %return; %finish

   program = "FROMFS"
   background(bpass)
   details(s, "FS", user, pass, file, newfile)
   check emas file(file)
   newfile = make fs file(file) %if newfile = ""

   define ("1,T#FROMFS")
   select output (1)
   print string ("
$on error then goto fail
$on severe then goto fail
$on warning then goto fail
$proc:='f$process()'
$len='f$length(proc)'
$name:=""NETSCRATCH:''f$extract(1,len,proc)'.TMP;""
$assign 'name logname")
   print string ("
$FROMFS/USER=".user."/FILE=".newfile." LOGNAME
".pass."
$r network:ftprog
device ".machine."
user ".uinfs(1)." ".bpass."
send logname /DELETE ".file." /?REPLACE
exit
$logo")
   print string ("
$fail:text:==""NETSCRATCH:''f$extract(1,len,proc)'.TXT;""
$open/write ef 'text
$write ef ""Error using FROMFS for")
   print string ("
$write ef ""   Username : ".user)
   print string ("
$write ef ""   Password : ".pass)
   print string ("
$write ef ""   Filename : ".newfile)
   print string ("
$close ef
$mail 'text ".UINFS(10)."::".uinfs(1)." /subj=""File transfer from ECS filestore to Emas""
$dele 'text
$logo
$tidy: on warning then goto end
$dele 'name
$end:
")
   select output (0)
   close stream (1)
   clear ("1")

   TRANSFER ("T#FROMFS,ECSVAX(NETFS,UNTYPEABLE),JOB,FAILMAIL")
   file = uinfs(1).".".file %unless file -> (".")
   newfile = user.":".newfile %unless newfile -> (".")
   print string(newfile." on a CS filestore will be copied to ".file)
   newline
%end

%end %of %file