constinteger max fsys = 99
recordformat fhf(integer end, start, size, type, free hole,
datetime, spare1, spare2)
recordformat pe (integer dest,srce,p1,p2,p3,p4,p5,p6)
recordformat rf (integer conad,filetype,datastart,dataend)
recordformat ftp bits(byteinteger qual, set, halfinteger value)
recordformat ftp strings(byteinteger qual, set, string (39) value)
recordformat tran document descriptorf(string (7) header, byteinteger state,
string (6) user,
(string (15) dest or integer spare1,spare2,spare3,spare4),
{these spare integers are for ftp use only and will be lost in SPOOLR calls}
(integer date and time received, date and time started or c
byteinteger FTRANS action, confirm, type, tfsys, integer transfer ident),
{the FTRANS units are set by us when requesting SPOOLR to do something}
halfinteger dap mins, dap c exec time,
integer date and time deleted,
start after date and time, priority, data start, data length,
integer time, (integer output limit or integer ftp data record),
halfinteger mode of access,
byteinteger priority requested, forms, mode, copies, order,
rerun, decks, drives, fails, outdev,
srce, output, delivery, name,
byteintegerarray vol label(1:8),
byteinteger external user, external password, external name,
ftp alias, storage codename, device type, device qualifier,
data type, text storage,
ftp user flags, ftp file password,special options, auto requeue,
guest address, ftp user flags2 ,sp5,
byteinteger properties,
byteinteger try emas to emas, ftp retry level,
(byteinteger string ptr or string (148) string space))
recordformat document descriptorf(byteinteger state,
string (6) user,
(string (15) dest or integer spare1,spare2,spare3,spare4),
{these spare integers are for ftp use only and will be lost in SPOOLR calls}
(integer date and time received, date and time started or c
byteinteger FTRANS action, confirm, type, tfsys, integer transfer ident),
{the FTRANS units are set by us when requesting SPOOLR to do something}
halfinteger dap mins, dap c exec time,
integer date and time deleted,
start after date and time, priority, data start, data length,
integer time, (integer output limit or integer ftp data record),
halfinteger mode of access,
byteinteger priority requested, forms, mode, copies, order,
rerun, decks, drives, fails, outdev,
srce, output, delivery, name,
byteintegerarray vol label(1:8),
byteinteger external user, external password, external name,
ftp alias, storage codename, device type, device qualifier,
data type, text storage,
ftp user flags, ftp file password,special options, auto requeue,
guest address,ftp user flags2, sp5,
byteinteger properties,
byteinteger try emas to emas, ftp retry level,
(byteinteger string ptr or string (148) string space))
!*
!*
recordformat queuef(string (15) name,
(halfintegerarray ftp lines(0 : 15) or halfintegerarray lines(0 : 15)),
string (7) default user,
string (31) default delivery,
integer default start, default priority, default time,
default output limit, default forms, default mode, default copies,
default rerun, length, head, max length, maxacr,
halfinteger q by, general access, integer resource limit,
amount)
!*
!
recordformat line f(string (15) name, string (7) unit name,
string (6) user, byteinteger parity,
integer status, bytes sent, bytes to go, block, part blocks,
document, integer bin offset, byteinteger service, user abort, unit size, fep,
integer abort retry count, offset, station ptr,
integerarray ispare(0:2),
integer data transfer start {for timing the transfer},account,
integer in comms stream, out comms stream,
integer in stream ident, out stream ident,
integer transfer status, tcc subtype,
in block addr, out block addr,
byteinteger activity, station type, spb2, suspend,
in stream status, out stream status,
timer, output buffer status, output transfer pending,
new FTP data record, byteintegerarray bspare(0:9),
integer aux document, pre abort status, bytes transferred,
record (pe) output transfer record)
!*
!*
!*
!*
recordformat ftp tablef(integer user fsys, binary data record, spare1, spare2,
byteinteger emastoemas, data mode,mail,mail to send, mail displ, sp1,sp2,sp3,
string (73) stopack message, byteintegerarray emastoemas header (0:31),
record (ftp bits) protocol id,mode,data type,text tran code,
text format,del pres,max tran rec size,tran limit,
file size,facilities,timeout,restart mark,
bin word size, bin format, Ispare,
record (ftp strings) username,username password,filename,file password,
private code name,device type,device type qualifier,
special options)
!*
record format pointers f(integer link list displ, ftp table displ, queues, queue entry size,
queue displ, queue name displ, streams, stream entry size, stream displ, hash length,
sp1, sp2, sp3, stations, station entry size, station displ,
control entry, station addresses displ, guest entry, byte integer array discs(0:max fsys),
string (63) dead letters, this full host, integer expanded address displ, integer array hash t(0:1023))
record format FTP station f(byte integer max lines ,
byteinteger status, byteinteger service ,
byteinteger connect retry ptr, fep,
address type, accounting,
byteinteger q lines ,
integer limit , integer last call, last response, system loaded,
connect attempts, connect retry time, integer array ispare(0:4),
integer seconds, bytes,
integer last q response by us,
p transfers, q transfers, p kb, q kb, p mail, q mail, integer name, shortest name,
integerarray address(1:4), integer pss entry, integer mail, integer ftp,
integer description, (integer queue or integer route), integer flags,
byteintegerarray string space(0 : 375){decrement this if more fields added, keep to 512 total})
record format name f(integer link, host entry, string (255) name)
!*
recordformat lcf(integer document, priority, size, station ptr,
(byteinteger spb1,ftp timer,ftp flags,gen flags or integer flags),
integer link,string (6) user, byteinteger order)
!*
conststring (5) this ukac = "UK.AC"
constinteger max documents = 1000
constinteger document entry size = 256
constinteger max stations = 512
constinteger max lines = 255
constinteger BASE type = 3
constinteger not assigned = x'80808080'
constinteger modes = 5
conststring (8)array mode key(1: modes) = c
"MAKE",
"REPLACE",
"FILE",
"OUTPUT",
"JOB"
constinteger options = 13
conststring (15) array option keys(1 : options) = c
".END",
"NOMAIL",
"FAILMAIL",
"DELIVERY",
"FORMS",
"PASS",
"TERMINATE",
"PRIORITY",
"SIZE",
"ANSI",
"SPECIAL",
"BINARY",
"TXT"
constinteger option help lines = 24
conststring (80) array option help(1 : option help lines) = c
"NOMAIL: No mail will be given when the transfer ends regardless",
" of the reason for termination.",
"FAILMAIL: Mail will only be given if the transfer fails.",
"PRIORITY: Set the priority of the transfer. Defaults to STD",
"SIZE: If the transfer is INcoming then here you can give",
" an estimated upper bound on the size (in Kbytes) of",
" the file. This will default to 100 Kbytes but it is",
" in your interest to set it.",
"DELIVERY: Only relevent when the transfer is INto a device",
" and sets the delivery information on the listing.",
"FORMS: As with DELIVERY, sets special forms requirment.",
"PASS: This sets a file password for this transfer.",
"ANSI: For INcoming transfers only. Set this if the file",
" has ANSI control chars and the transfer of the file has",
" already given problems.",
"BINARY: An INcoming transfer can be either TEXT or BINARY and it",
"TXT: is the the negotiation between the two hosts that determines",
" which is the case. With some systems (ie PRIME) you will need",
" to specify the type of transfer initially. In this case use",
" one of these two options.",
"SPECIAL: This field can be set to convey extra information to the",
" External System. The use of this field will normally be ",
" specified by the External System documentation.",
"TERMINATE: This abandons the transfer under construction."
constinteger priorities = 5
conststring (5)array priority names(1 : priorities) = c
"VLOW",
"LOW",
"STD",
"HIGH",
"VHIGH"
conststring (1) snl = "
"
constinteger yes = 1
constinteger r = b'00000001'
constinteger sh = b'00001000'
constinteger no = 0
!THE FTP USER FLAGS FOLLOW
!-------------------------
!First set
constbyteinteger no mail = x'01'
constbyteinteger fail mail = x'02'
constbyteinteger overwrite = x'04'
constbyteinteger non text or data = x'08'
constbyteinteger data = x'20'
constbyteinteger ANSI = x'10'
constbyteinteger local output = x'40'
constbyteinteger binary read only = x'80'
!Second set
constbyteinteger text read only = x'01'
constbyteinteger in = 1
constbyteinteger out = 0
constbyteinteger make = 1
constbyteinteger replace = 2
constbyteinteger file = 3
constbyteinteger output = 4
constbyteinteger job = 5
systemintegerfnspec current packed dt
systemintegerfnspec pack date and time(string (8) date, time)
systemstring (8) fnspec unpack date(integer p)
systemstring (8) fnspec unpack time(integer p)
systemroutinespec outfile(string (31) name, integer length, max, prot, c
integername conad, flag)
externalintegerfnspec uinfi(integer type)
externalstringfnspec uinfs(integer type)
systemroutinespec connect(string (31) name, integer access, maxbytes, c
protection, record (rf) name r, integername flag)
systemstringfnspec failure message(integer flag)
systemroutinespec disconnect(string (31) s,integername flag)
systemroutinespec destroy(string (31) s, integername flag)
externalroutinespec journal off alias "s#journaloff"
systemroutinespec console(integer ep, integer i,j)
externalroutinespec setmode(string (255) s)
externalintegerfnspec dexecmess(string (6) user, integer sact,len,addr)
systemstringfnspec itos(integer i)
externalintegerfnspec dfsys(string (6) user,integername fsys)
externalintegerfnspec dspool(record (pe) name p, integer len, addr)
externalroutinespec prompt(string (31) s)
systemroutinespec move(integer l, f, t)
systemroutinespec psysmes(integer root,flag)
externalroutine call transfer(string (39) external site, external user,
external user password, external filename, local filename,
output device,
integer directionp, modep, mail, integername document no,
stringname info, integer sp option int, string (127) sp option str)
!****************************************************************
!* *
!* This is a routine to give param call access to file transfer *
!* via FTP-B(80). *
!* *
!****************************************************************
record (fhf)name file header
record (pe) p
record (rf) r
record (tran document descriptorf) document, new doc
string (64) reply, s1, s2, s3, lfile, xfilename, lbase
string (11) tfile
integer flag, direction, conad, pages, mode, another pass, i , j
switch mode sw(1 : modes)
switch option act(1 : options)
switch direction sw(out : in)
stringfn doc string(record (tran document descriptor f)name document,
byteintegername ptr)
if ptr = 0 then result = "" else c
result = string(addr(document_string space) + ptr)
end
integerfn s to i(stringname s)
string (255) p, ns1, ns2
integer total, sign, ad, i, j, hex
hex = 0; total = 0; sign = 1
ad = addr(p)
a: if s ->ns1.(" ").ns2 and ns1="" then s=ns2 and -> a; !CHOP LEADING SPACES
if s ->ns1.("-").ns2 and ns1="" then s=ns2 and sign = -1
if s ->ns1.("X").ns2 and ns1="" then s=ns2 and hex = 1 and -> a
p = s
unless s -> p.(" ").s then s = ""
i = 1
while i <= byteinteger(ad) cycle
j = byte integer(i+ad)
-> fault unless '0' <= j <= '9' or (hex # 0 c
and 'A' <= j <= 'F')
if hex = 0 then total = 10*total c
else total = total<<4+9*j>>6
total = total+j&15; i = i+1
repeat
if hex # 0 and i > 9 then -> fault
if i > 1 then result = sign*total
fault:
s = p.s
result = not assigned
end ; !OF INTEGERFN S TO I
stringfn l to u(string (63) s)
integer i
reply=s
cycle i = 1,1,length(reply)
byteinteger(addr(reply)+i)=byteinteger(addr(reply)+i)&95 if 'a'<=byteinteger(addr(reply)+i)<='z'
repeat
result = reply
end
routine to doc string(record (tran document descriptorf)name document,
byteintegername field, stringname value)
field = 0 and return if value = ""
field = x'ff' and return if document_string ptr + length(value) > 147
field = document_string ptr
string(addr(document_string space) + document_string ptr) = value
document_string ptr = document_string ptr + length(value) + 1
end
routine fail(string (63) s)
info <- "File Transfer fails: ".s
newline
end
document = 0
another pass = no
document_string ptr = 1
document_dest = "FTP"
document_priority = -1
document no = 0
tfile = ""
if external site = "" start
info <- "Must give the EXTERNAL-SITE name.".snl
return
finish
external site = l to u(external site)
to docstring(document,document_ftp alias,external site)
unless out <= directionp <= in start
info <- "Direction ?: IN = 1; OUT = 0".snl
return
finish
direction = directionp
unless make <= modep <= output start
info <- "Mode ?: 1-Make; 2-Replace; 3-File; 4-Output".snl
return
finish
mode = modep
if direction = in and replace <= mode <= file then document_ftp user flags = c
document_ftp user flags ! overwrite
if external user # "" c
then to docstring(document,document_external user,external user)
unless external user password = "" c
then to docstring(document,document_external password,external user password)
new doc = document
unless direction = out and mode = output start
if external filename = "" start
info <- "Give the filename at ".docstring(document,document_ftp alias).".".snl
return
finish
xfilename = external filename
finish
unless direction = in and mode = output start
lfile = local filename
if lfile -> s1.("_").s2 and direction = in then start
info <- "Cannot transfer INto PD file".snl
return
finish
lbase = ""
if lfile -> s1.(".").s2 then lfile = s2 and lbase = s1."."
if lbase # "" and direction = in start
info <- "cannot copy INto another user's index.".snl
return
finish
cycle i = 1,1,length(lfile)
j = byteinteger(addr(lfile)+i)
unless (i > 1 and '0' <= j <= '9') or 'A' <= j&95 <= 'Z' c
or ( i>1 and j = '#') then info <- "Invalid local filename".snl and return
repeat
connect(lbase.lfile,0,0,0,r,flag)
if flag # 0 and direction = out start
info <- failure message(flag).snl
return
finish
if direction = out start
file header == record(r_conad)
document_data length = file header_end-file header_start
if document_data length = 0 then info <- lfile." empty.".snl c
and return
document_data start = file header_start
finish else document_data length = 100<<10
if flag # 0 and direction = in and mode = replace start
info <- lfile." does not exist!".snl
return
finish
if flag = 0 and direction = in start
if replace <= mode <= file then c
info <- "Overwriting ".lfile.snl
if mode = make start
info <- lfile." already exists.".snl
return
finish
finish
finish
-> mode sw(mode)
mode sw(1):
if direction = in then document_mode of access = x'8002' c
else document_mode of access = x'0001'
-> direction sw(direction)
mode sw(2):
if direction = in then document_mode of access = x'8002' else c
document_mode of access = x'0002'
-> direction sw(direction)
mode sw(3):
if direction = in then document_mode of access = x'8002' else c
document_mode of access = x'0003'
-> direction sw(direction)
mode sw(4):
if direction = in then document_mode of access = x'8002' c
else document_mode of access = x'4001'
if output device = "" start
info <- "Output Device required.".snl
return
finish
to docstring(document,document_device type,output device)
-> direction sw(direction)
direction sw(in):
if mode = output then to docstring(document,document_name,reply) c
else to docstring(document,document_name,lfile)
to docstring(document,document_external name,xfilename)
-> transfer
direction sw(out):
if r_filetype # 3 then document_ftp user flags = document_ftp user flags ! c
non text or data and printstring("Warning, this non text transfer will only succeed with". c
" another EMAS 2900.".snl)
pages = (integer(r_conad)+4095)>>12
tfile <- "f#".lfile
if tfile -> s1.("_").s2 then tfile = s1
outfile(tfile,pages<<12,pages<<12,0,conad,flag)
if flag # 0 then fail(failure message(flag))
move(integer(r_conad),r_conad,conad)
disconnect(tfile,flag)
to docstring(document,document_srce,tfile)
to docstring(document,document_name,lfile)
unless mode = output then to docstring(document,document_external name,xfilename)
transfer:
unless mode = output and direction = in then disconnect(lbase.lfile,flag)
unless 1 <= mail <= 3 start
info <- "MAIL ?: 1-Full; 2-Fail only; 3-None.".snl
return
finish
-> option act(mail)
option act(1):
-> go
option act(2):
document_ftp user flags = document_ftp user flags ! no mail
-> go
option act(3):
document_ftp user flags = document_ftp user flags ! fail mail
go:
document_header = "BINDOC:"
p = 0
flag = 0
flag = dspool(p,(5<<24)!264,addr(document))
if flag # 0 and flag # p_p1 then destroy(tfile,flag) c
and fail("DSPOOL failure") and return
destroy(tfile,flag)
if p_p1 = 0 start
document no = p_p2
finish else start
if p_p1 = 1 then fail("Local user not known !!!") and return
if p_p1 = 2 then fail("No free spooler descriptors.") and return
if p_p1 = 3 then fail("DTRANSFER/DCONNECT fails") and return
if p_p1 = 4 then fail("Unknown external system. ") and return
if p_p1 = 5 then fail("Transfer queue full.") and return
if p_p1 = 6 then fail("Bad params!") and return
if p_p1 = 7 then fail("Unaccepted mode of transfer") and return
if p_p1 = 8 then fail("Gateway FTP access barred, accreditation required.") and return
fail("Unknown failure") and return
finish
end
externalroutine transfer(string (255) s)
!****************************************************************
!* *
!* This is a routine to give user access to file transfer *
!* via FTP-B(80). *
!* *
!****************************************************************
externalroutinespec transfers(string (255) s)
record (fhf)name file header
record (name f)name name entry
record (pe) p
record (rf) re
record (tran document descriptorf) document, new doc
record (ftp station f)arrayformat ftpsf(1:max stations)
record (ftp station f)arrayname ftp stations
record (pointers f)name pointers
string (132) s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, options string, residual
string (64) lfile, xfilename, lbase,last key checked
string (255) reply
string (200) message
string (11) tfile
integer flag, direction, conad, pages, mode, another pass, i, j, k, l, m, extra prompts, prompt input, dummy
integer stations, options set,true option, option fault check, help required
integer more, first entry
integer transfers call
integer hash length
switch mode sw(1 : modes)
switch option act(1 : options)
switch lopt(1 : options)
switch direction sw(out : in)
byteintegerarray set (1 : max stations)
integerfnspec get param(stringname sp, integer single param only)
stringfn doc string(record (tran document descriptor f)name document,
byteintegername ptr)
if ptr = 0 then result = "" else c
result = string(addr(document_string space) + ptr)
end
integerfn s to i(stringname s)
string (255) p, ns1, ns2
integer total, sign, ad, i, j, hex
hex = 0; total = 0; sign = 1
ad = addr(p)
a: if s ->ns1.(" ").ns2 and ns1="" then s=ns2 and -> a; !CHOP LEADING SPACES
if s ->ns1.("-").ns2 and ns1="" then s=ns2 and sign = -1
if s ->ns1.("X").ns2 and ns1="" then s=ns2 and hex = 1 and -> a
p = s
unless s -> p.(" ").s then s = ""
i = 1
while i <= byteinteger(ad) cycle
j = byte integer(i+ad)
-> fault unless '0' <= j <= '9' or (hex # 0 c
and 'A' <= j <= 'F')
if hex = 0 then total = 10*total c
else total = total<<4+9*j>>6
total = total+j&15; i = i+1
repeat
if hex # 0 and i > 9 then -> fault
if i > 1 then result = sign*total
fault:
s = p.s
result = not assigned
end ; !OF INTEGERFN S TO I
routine all hosts with ( byteintegerarrayname set, stringname key, last)
integer link, i, flag
string (63) zs
string (63) comp
comp = key
last = comp
cycle i = 0, 1, hash length
link = pointers_hash t ( i )
while link # -1 cycle
name entry == record ( re_conad + link )
if name entry_name -> ( ".".comp."." ) or name entry_name -> zs.( comp ) c
or name entry_name -> ( comp ).zs then set(name entry_host entry) = yes
link = name entry_link
repeat
repeat
end
routine to doc string(record (tran document descriptorf)name document,
byteintegername field, stringname value)
field = 0 and return if value = ""
field = x'ff' and return if document_string ptr + length(value) > 147
field = document_string ptr
string(addr(document_string space) + document_string ptr) = value
document_string ptr = document_string ptr + length(value) + 1
end
routine read prompt reply(stringname reply, integer sig)
!This routine reads the reply to an issued prompt.
integer i
reply=""; !Clear out the reply area.
skipsymbol and return if nextsymbol = nl
while nextsymbol#nl cycle
readsymbol(i)
i=i&95 if sig = no and 'a'<=i<='z'
reply <- reply.tostring(i)
repeat
skipsymbol
end ; !OF READ PROMPT REPLY.
integer fn hashed(string (63) name)
integer i, pt, n, h
byte integer array x(0:15)
const byte integer array prime(1:7)= 23, 19, 11, 7, 5, 13, 17
pt = (addr(x(7))>>3)<<3
longinteger(pt) = 0
n = addr(name)
byteinteger(pt+i&7) = byteinteger(pt+i&7)!!byteinteger(n+i) for i = 0, 1, length(name)
h = length(name)*29
h = h+prime(i)*byteinteger(pt+i) for i = 1, 1, 7
result = h&hash length
end ; !of hashed
integer fn lookup hasht(string (63) name)
record (name f) name name entry
integer h
h = hashed(name)
if pointers_hasht(h)#-1 start
name entry == record(re_conad + pointers_hasht ( h ))
cycle
if name=name entry_name then result = name entry_host entry
exit if name entry_link = -1
name entry == record ( re_conad + name entry_link )
repeat
finish
result = 0
end ; !of lookup hasht
integer fn lookup host(string (63) name)
integer i
string (63) rest
{uctranslate or lc?}
i = lookup hasht(name)
if i#0 then result = i
unless name->(this ukac.".").rest start
i = lookup hasht(this ukac.".".name); !prefix uk.ac
if i#0 then result = i
if name->name.(".").rest then result = lookup hasht(name); !for arpa.
finish
result = 0
end ; !of lookup host
stringfn reverse(string (255) st)
!this routine reverses a string
string (255) ss
integer l, i, addrss, addrst
! printstring(st.snl)
result = st if st = ""
l = length(st)
!write(l,3);newline
addrss = addr(ss)
addrst = addr(st) + l + 1
l = length(st)
cycle i = 1,1,l
byteinteger(addrss+i) = byteinteger(addrst-i)
repeat
length(ss) = l
!printstring(ss.snl)
!write(length(ss),3);newline
result = ss
end
routine uc tran(stringname string)
integer i,j
if length(string) > 0 start
cycle i = 1,1,length(string)
j = byteinteger(addr(string)+i)
byteinteger(addr(string)+i) = j&95 if 'a'<=j<='z'
repeat
finish
end ; !of routine UC TRAN
routine fail(string (63) s)
printstring("Queueing of transfer request fails: ".s)
newline
stop
end
routine connect trans db(integername flag)
connect("FTRANS.CFILE",r!sh,0,0,re,flag)
!connect("TESTFILE",r,0,0,re,flag)
if flag # 0 and flag # 34 start
printstring("Cannot connect TRANSFER systems database".snl)
return
finish
flag = 0
file header == record(re_conad)
pointers == record(re_conad + file header_start)
stations = pointers_stations
hash length = pointers_hash length
ftp stations == array(re_conad + pointers_station displ,ftpsf)
end
connect trans db(flag)
return if flag # 0
document = 0
reply = s
if reply -> ("FROMTRANSFERS").reply or (s -> s1.("?").s2 and s1 = "" and s2 # "") c
then s = "" and transfers call = yes else transfers call = no
another pass = no
dummy = 0
option fault check = no
help required = no
document_string ptr = 1
document_dest = "FTP"
document_priority = -1
tfile = ""
cycle i = 1,1,stations
set(i) = no
repeat
last key checked = ""
extra prompts = yes; prompt input = yes
if s = "" or transfers call = yes start
if transfers call = no then c
printstring("Reply '?' for help after any prompt.".snl)
sys:
s3 = ""
j = 1
more = no
first entry = yes
cycle
if transfers call = no then prompt("External System : ") and c
read prompt reply(reply,no) else start
if transfers call = yes and first entry = no then prompt(": ") c
and read prompt reply(reply,no)
finish
if reply ->("?").s4 and s4 # "" start
m = lookup host(s4)
if m # 0 and ftp stations(m)_address type # base type start
printstring("This is an External system, do you want full details?:".snl)
cycle
prompt("yes or no :")
read prompt reply(s5,no)
exit if s5 ->("Y").s6 or s5->("N").s6
repeat
if s5 -> ("Y").s6 start
transfers(s4)
s3 = s4
more = yes
connect trans db(flag)
printstring("type '?' to continue; '?key' to start search on 'key'; ")
if transfers call = yes then printstring(" <return> terminates".snl) c
else printstring(" Or select a system".snl)
first entry = no
continue
finish
finish
finish
if s3 # "" or first entry = no start
if reply -> ("?").s4 and s4 #s3 and more = yes start
unless s4 = "" and s3 # "" start
if s3 = "" then printstring("Full host listing abandoned.") c
else printstring("Search on key ".s3." abandoned.")
printstring(" New key search on ".s4.snl)
j = 1
cycle m = 1,1,stations
set(m) = no
repeat
last key checked = ""
finish else printstring("Continuing key search.".snl) and reply = "?".s3
finish
finish
first entry = no
more = no
if reply -> ("?").s3 then start
if s3 = "" start
if transfers call = yes then s1 = "Full list is" else c
s1 = "Give the name of the external system you wish to ".snl. c
"transfer the file to of from. Currently available are"
finish else s1 = "Matches found are"
if j = 1 then uc tran(s3) and printstring(snl.s1.": ".snl.snl) c
else newline
k = 0
all hosts with(set,s3, last key checked) if s3 # "" and s3 # last key checked
cycle i = j,1,stations
if ftp stations(i)_status < 5 and ftp stations(i)_address type # base type start
!We have a service stations.
if s3 # "" and set(i) = no start
s7 = string(addr(ftp stations(i)_string space(0))+ftp stations(i) _ c
description)
uc tran(s7)
unless s7 -> s1.(s3).s2 then continue
finish
l = byteinteger(addr(ftp stations(i)_string space(0))+ftp stations(i)_shortest name)
printstring(string(addr(ftp stations(i)_string space(0)) c
+ ftp stations(i)_shortest name))
if l < 17 then spaces(17-l)
reply = string(addr(ftp stations(i)_string space(0)) c
+ ftp stations(i)_description)
if reply -> ("~").s1 then reply = s1
printstring("- ".reply.snl)
k = k + 1
finish
if (k//16)*16 = k and k # 0 and i # stations start
printstring(snl."more....type '?' to continue; '?key' to start key search;")
if transfers call = yes then printstring(" <return> to terminate.".snl)c
else printstring(" Or select a system".snl)
more = yes
j = i+1
exit
finish
repeat
finish else exit
if more = no start
printstring("type '?' for full list; '?key' to start search on 'key';")
if transfers call = yes then printstring(" <return> terminates".snl) c
else printstring(" Or select a host.".snl)
s3 = ""
more = no
j = 1
cycle m = 1,1,stations
set(m) = no
repeat
last key checked = ""
finish
repeat
return if transfers call = yes
unless reply ->s1.("[").s2.("]").s3 and s1=s3="" start
i = lookup host(reply)
if i = 0 then printstring("External System not known".snl) and -> sys
finish
to docstring(document,document_ftp alias,reply)
another:
direction = out
cycle
prompt("Direction : ")
read prompt reply(reply,no)
!
exit if reply = "IN" or reply = "OUT"
printstring(snl."Reply either IN : FROM ".docstring(document,document_ftp alias))
printstring(" TO local EMAS ".snl. c
" or OUT : FROM local EMAS TO ".docstring(document,document_ftp alias).snl)
repeat
if reply = "IN" then direction = in
cycle
prompt("Mode : ")
read prompt reply(reply,no)
if length(reply) >= 2 start
mode = 0
cycle i = 1,1,modes
if mode key(i) -> (reply).s1 then mode = i and exit
repeat
if direction = in and replace <= mode <= file then document_ftp user flags = c
document_ftp user flags ! overwrite
exit if mode # 0
finish
if direction = in start
s1 = "your filespace"
s2 = "to a UKCnet device"
s3 = "Request output from a SPOOL queue at ".docstring(document,document_ftp alias)
s3 = s3.snl." ".s2
finish else start
s1 = "the filespace at ". docstring(document,document_ftp alias)
s2 = "to a device at ". doc string(document,document_ftp alias).snl." (Not available". c
" on all systems)"
s3 = "Submit a JOB to run at ".docstring(document,document_ftp alias)
finish
printstring(snl."There are five modes:".snl)
printstring("MAKE Make a new file in ".s1.snl. c
"REPLACE Replace an existing file in ".s1.snl)
printstring("FILE REPLACE or MAKE a file in ".s1.snl. c
"OUTPUT Output the file ".s2.snl)
printstring("JOB ".s3.snl)
repeat
if another pass = no start
cycle
prompt("External Username : ")
read prompt reply(reply,yes)
exit unless reply = "?"
printstring(snl."Give the username at ".docstring(document,document_ftp alias)." who is the ". c
" second party in the transfer.".snl)
repeat
to docstring(document,document_external user,reply)
get pass:
cycle
prompt("External user pass : ")
flag = uinfi(2)
if flag = 1 then {foreground} journal off
setmode("ECHO=OFF")
read prompt reply(reply,yes)
setmode("ECHO=ON")
if flag = 1 then console(14,dummy,dummy)
exit unless reply = "?"
printstring(snl.snl."Give the 'External user pass' for ".docstring(document,document_external user). c
" at ".docstring(document,document_ftp alias).snl)
printstring("If no 'user specific' password is required then hit <return>". c
snl."NOTE i) a filename password may be required and this can be ". c
snl." set using the 'Option' facility that follows.".snl. c
" ii) The user pass on EMAS is the background password.".snl)
repeat
newline
unless reply = "" then to docstring(document,document_external password,reply)
if prompt input = no then -> got pass
new doc = document
finish
unless direction = out and mode = output start
if mode = job and direction = out then s1 = "jobname" else s1 = "filename"
cycle
prompt("External ".s1." : ")
reply = ""
read prompt reply(xfilename,yes)
exit unless xfilename = "?"
printstring(snl."Give the ".s1." at ".docstring(document,document_ftp alias).".".snl)
repeat
finish
finish else start
!we have a single line command
if length(s) > 132 then printstring("Command line too long".snl) and return
!printstring("Line : ".s.snl)
if s = "?" or s = "HELP" or s = "help" then start
message = "for example:".snl."TRANSFER( fred, UKC(ecdw12,passy)LP, output)".snl
message = message ."and the extended form:".snl."TRANSFER( fred, ukc(ecdw12,passy)"
message = message."mill, job,failmail,special(time=30,out=LPtx) )".snl
help required = yes and -> fail structure
finish
prompt input = no
s = reverse(s)
options set = no
extra prompts = no
if (s-> s1.("+").s2 and s1 = "") or (s->s1.(",").s2 and s1 = "") then extra prompts = yes and s = s2
s = reverse(s)
!Now see if a OPTIONS section is included.
cycle i = 1,1,options
cycle j = 2,1,length(option keys(i))
s3 = option keys(i); length(s3) = j
s3 = ",".s3
cycle k = 1,1,modes
cycle l = 2,1,length(mode key(k))
s2 = mode key(k)
length(s2) = l
s1 = ",".s2.s3
if s -> s7.(s1).s4 and ((s4 -> s5.(",").s6 and s5 = "") or c
(s4 -> s5.("(").s6 and s5 = "") or s4 = "") start
s = s7.",".mode key(k)
options set = yes
option fault check = yes
options string = option keys(i).s4
!printstring("main string : ".s.snl."options : ".options string.snl)
exit
finish
repeat
exit if options set = yes
repeat
exit if options set = yes
repeat
exit if options set = yes
repeat
option fault check = no
i = 0; direction = out
if s -> s5.("(").s1 start
if s5 -> s8.("[").s9.("]").s10 and s8=s10="" then i = pointers_guest entry c
else i = lookup host(s5)
if i # 0 start
!We have found a host.
direction = in
s2 = "(".s1
s1 = ""
finish else start
s7 = s
s1 = ""
cycle
exit unless s7 -> s4.(",").s5.("(").s3
if s5 -> s8.("[").s9.("]").s10 and s8=s10="" then i = pointers_guest entry c
else i = lookup host(s5)
s1 = s1.s4.","
s2 = "(".s3
exit if i # 0 {We have found a host}
s7 = s5."(".s3
repeat
finish
finish
if i = 0 then message = "Cannot find a reference to a known 'External System'" c
and -> fail structure
to docstring(document,document_ftp alias,s5)
if direction = out start
if s1 -> s1.(",").s3 then lfile = s1 else message = "Cannot find the 'Local Name'." c
and -> fail structure
finish
s2 = reverse(s2)
unless s2 -> s1.(",").s2 then message = "Cannot find a valid 'Mode'." and -> fail structure
s1 = reverse(s1)
mode = 0
cycle i = 1,1,modes
if mode key(i) -> (s1).residual then mode = i and exit
repeat
if mode = 0 or length(s1) < 2 then message = "The 'Mode' is not understood." and -> fail structure
if direction = in start
if replace <= mode <= file then document_ftp user flags = c
document_ftp user flags ! overwrite
unless s2 -> lfile.(",").s2 then message = "Cannot find the 'Local Name'." and -> fail structure
lfile = reverse(lfile)
finish
s2 = reverse(s2)
unless s2 -> ("(").s2.(")").xfilename then message = "Cannot find the 'External Name'." c
and -> fail structure
s2 = reverse(s2)
unless s2 -> s1.(",").s2 then message = "Cannot find the 'External User Pass'." and -> fail structure
s1 = reverse(s1)
todocstring(document,document_external password,s1)
s2 = reverse(s2)
todocstring(document,document_external user,s2)
!
!Now look at the supplied (if it is ) options string.
if options set = yes start
option fault check = yes
options string = ",".options string
cycle
true option = no
cycle i = 1,1,options
cycle j = length(option keys(i)),-1,2
s2 = option keys(i); length(s2) = j
s2 = ",".s2
if options string -> s1.(s2).s7 and s1 = "" start
options string = s7
true option = yes
!printstring("op: ".option keys(i)."; left : ".options string.snl)
-> lopt(i)
finish
continue
lopt(1): exit
lopt(2): if get param(s4,yes) = 0 then message = "No parameter needed for ". c
option keys(i) and -> fail structure
!printstring("NO MAIL set".snl)
document_ftp user flags = document_ftp user flags ! no mail and exit
lopt(3): if get param(s4,yes) = 0 then message = "No parameter needed for ". c
option keys(i) and -> fail structure
!printstring("FAIL MAIL set".snl)
document_ftp user flags = document_ftp user flags ! fail mail and exit
lopt(4): if get param(s4,no) # 0 then message = "Parameter needed for ". c
option keys(i) and -> fail structure
!printstring("DELIVERY set to : ".s4.snl)
to docstring(document,document_delivery,s4) and exit
lopt(5): if get param(s4,yes) # 0 then message = "Parameter needed for ". c
option keys(i) and -> fail structure
k = s to i(s4)
if 0 <= k <= 255 then document_forms = k {%and printstring("FORMS set to : ".s4.snl)} and exit
message = "Forms parameter in range 0 -> 255 please." and -> fail structure
lopt(6): if get param(s4,no) # 0 then message = "Parameter needed for ". c
option keys(i) and -> fail structure
printstring("FILE PASSWORD set to : ".s4.snl)
to docstring(document,document_ftp file password,s4) and exit
lopt(7): if get param(s4,no) = 0 then message = "No parameter needed for ". c
option keys(i) and -> fail structure
-> term
lopt(8): if get param(s4,yes) # 0 then message = "Parameter needed for ". c
option keys(i) and -> fail structure
cycle k = 1,1,priorities
if priority names(k) = s4 then document_priority = k {%and printstring(} c
{"PRIORITY set to : ".s4.snl)} and exit
repeat
unless document_priority = -1 then exit
message = "Invalid PRIORITY parameter" and -> fail structure
lopt(9): if get param(s4,yes) # 0 then message = "Parameter needed for ". c
option keys(i) and -> fail structure
!printstring("SIZE set to : ".s4.snl)
k = s to i(s4)
document_data length = k<<10
exit
lopt(10):
lopt(12):
lopt(13): if get param(s4,yes) = 0 then message = "No parameter needed for". c
" option ".option keys(i) and -> fail structure
if direction # in then message = option keys(i)." on INcom". c
"ng transfers only." and -> fail structure
if i = 10 then document_ftp user flags = document_ftp user flags ! ANSI
if i = 12 then document_ftp user flags = document_ftp user flags c
! binary read only
if i = 13 then document_ftp user flags2 = document_ftp user c
flags2 ! text read only
exit
lopt(11): if get param(s4,no) # 0 then message = "No parameter for". c
" option ".option keys(i) and -> fail structure
printstring("SPECIAL set to : ".s4.snl)
to docstring(document,document_special options,s4)
repeat
if options string = "" or true option = yes then exit
repeat
exit if options string = ""
if true option = no then message = "Cannot interpret options : ". c
options string and -> fail structure
repeat
finish
option fault check = no
if docstring(document,document_external password) = "?" then -> get pass
got pass:
finish
unless direction = in and mode >= output start
if prompt input = yes start
locn:
cycle
prompt("Local filename : ")
reply = ""
read prompt reply(lfile,no)
exit unless lfile = "?"
printstring(snl."Give the filename on EMAS.".snl)
repeat
finish
if lfile -> s1.("_").s2 and direction = in then start
printstring("Cannot transfer INto PD file".snl)
-> locn
finish
lbase = ""
if lfile -> s1.(".").s2 then lfile = s2 and lbase = s1."."
if lbase # "" and direction = in start
printstring("cannot copy INto another user's index.".snl)
-> locn
finish
if direction = in start
unless 1<= length(lfile) <= 11 then printstring("Local filename wrong length".snl) c
and -> locn
cycle i = 1,1,length(lfile)
j = byteinteger(addr(lfile)+i)
unless (i > 1 and '0' <= j <= '9') or 'A' <= j&95 <= 'Z' c
or ( i>1 and j = '#') then printstring("Invalid local filename".snl) and -> locn
repeat
finish
connect(lbase.lfile,0,0,0,re,flag)
if flag # 0 and direction = out start
PRINTSTRING("***")
printstring(failure message(flag).snl)
-> locn
finish
if direction = out start
file header == record(re_conad)
document_data length = file header_end-file header_start
if document_data length = 0 then printstring(lfile." empty.".snl) c
and -> locn
document_data start = file header_start
finish else document_data length = 100<<10
if flag # 0 and direction = in and mode = replace start
printstring("Cannot 'REPLACE', ".lfile." does not exist!".snl)
-> locn
finish
if flag = 0 and direction = in start
if replace <= mode <= file then c
printstring("Overwriting ".lfile.snl)
if mode = make start
printstring("Cannot 'MAKE', ".lfile." already exists.".snl)
-> locn
finish
finish
finish
-> mode sw(mode)
mode sw(1):
if direction = in then document_mode of access = x'8002' c
else document_mode of access = x'0001'
-> direction sw(direction)
mode sw(2):
if direction = in then document_mode of access = x'8002' else c
document_mode of access = x'0002'
-> direction sw(direction)
mode sw(3):
if direction = in then document_mode of access = x'8002' else c
document_mode of access = x'0003'
-> direction sw(direction)
mode sw(4):
if direction = in then document_mode of access = x'8002' c
and s1 = "Local " else document_mode of access = x'4001' and s1 = "External "
get device:
if direction = in then document_ftp user flags = document_ftp user flags ! local output
!if set the user flags to say this incomming locally initiated file
!transfer is to go to a device that will be plonked in the DEVICE TYPE field.
if prompt input = yes start
cycle
prompt(s1."device name : ")
reply = ""
read prompt reply(reply,no)
if reply = "?" then start
if direction = in then printstring(snl."This is an incoming ". c
"transfer so the device must be a valid ".snl."UKC printer, ie LP,LPCL..".snl)
if direction = out then printstring(snl."This is an outgoing transfer ". c
"so you must give a device at".snl.docstring(document, c
document_ftp alias).", if in doubt ". c
"reply LP and the system at ".docstring(document,document_ftp alias). c
" will".snl."be asked to make the choice".snl)
finish else exit
repeat
finish else start
if direction = in then reply = lfile else reply = xfilename
finish
if s1 = "Local " and reply -> (".").s1 then reply = s1
to docstring(document,document_device type,reply)
-> direction sw(direction)
mode sw(5):
!the JOB mode
if direction = in start
document_mode of access = x'C001'
s1 = "local "
-> get device
finish
document_mode of access = x'2001'
-> direction sw(direction)
direction sw(in):
if mode >= output then to docstring(document,document_name,reply) c
else to docstring(document,document_name,lfile)
to docstring(document,document_external name,xfilename)
-> transfer
direction sw(out):
if re_filetype # 3 and re_filetype # 4 c
then document_ftp user flags = document_ftp user flags ! non text or data c
and printstring("Warning, this non text transfer will only succeed with". c
" EMAS 2900".snl) c
else if re_filetype = 4 start
document_ftp user flags = document_ftp user flags ! data
document_ftp data record = integer(re_conad + 24)
!The binary date record structure word.
finish
pages = (integer(re_conad)+4095)>>12
tfile <- "F#".lfile
if tfile -> s1.("_").s2 then tfile = s1
outfile(tfile,pages<<12,pages<<12,0,conad,flag)
if flag # 0 then fail(failure message(flag))
move(integer(re_conad),re_conad,conad)
disconnect(tfile,flag)
to docstring(document,document_srce,tfile)
to docstring(document,document_name,lfile)
unless mode = output then to docstring(document,document_external name,xfilename)
transfer:
unless mode >= output and direction = in then disconnect(lbase.lfile,flag)
!first pick up any special options.
if extra prompts = no then -> skip options
cycle
prompt("Options :")
read prompt reply(reply,no)
if reply = "?" start
printstring(snl."The option section allows you to set any extra control". c
" that may be required.".snl."It is terminated by '.END'".snl. c
"The options available are:".snl)
s1 = ""
cycle i = 1,1,options
s1 = s1." ".option keys(i)
if length(s1) > 60 then printstring(s1.snl) and s1 = ""
repeat
if 0 < length(s1) <= 60 then printstring(s1.snl)
printstring("NOTE that the first two letters will suffice.".snl. c
"reply '?' for FURTHER DETAILS or select an option.".snl)
prompt("Options :")
read prompt reply(reply,no)
if reply -> s1.("?").s2 start
printstring("The final result of a transfer is, by default, reported ". c
" to the".snl."initiating user via MAIL. There are two options". c
" override this.".snl)
printstring("All File Transfer activity is handled like other". c
" user documents ".snl."and so the subsystem commands DOCUMENTS etc. can be used.".snl)
cycle i = 1,1,option help lines
printstring(option help(i).snl)
repeat
continue
finish
finish
cycle i = 1,1,options
if length(reply) >= 2 and option keys(i) -> (reply).s1 then -> option act(i)
repeat
printstring("Invalid option".snl)
continue
option act(1):
exit
option act(2):
document_ftp user flags = document_ftp user flags ! no mail
continue
option act(3):
document_ftp user flags = document_ftp user flags ! fail mail
continue
option act(4):
cycle
prompt("Deliver to: ")
read prompt reply(reply,no)
if reply = "?" then printstring(snl."Give the delivery information ". c
"(for example: J.K.H at SIAE)".snl) and continue
to docstring(document,document_delivery,reply)
exit
repeat
continue
option act(5):
cycle
prompt("Forms setting: ")
read prompt reply(reply,no)
if reply = "?" then printstring(snl."0 -> 255 are valid forms settings".snl) c
and continue
i = s to i(reply)
if 0<=i<=255 then document_forms = i and exit else c
printstring("Invalid forms, 0 -> 255 !".snl)
repeat
continue
option act(6):
cycle
prompt("File password: ")
flag = uinfi(2)
if flag = 1 then {foreground} journal off
setmode("ECHO=OFF")
read prompt reply(reply,yes)
setmode("ECHO=ON")
if flag = 1 then console(14,dummy,dummy)
newline
if reply = "?" or reply = "" then printstring c
("Give the FTP password that is assigned to the file at ". c
docstring(document,document_ftp alias).snl) and continue
exit
repeat
to docstring(document,document_ftp file password,reply)
continue
option act(7):
destroy(tfile,flag)
-> term
option act(8):
cycle
prompt("value: ")
read prompt reply(reply,no)
if length(reply) >1 start
cycle i = 1,1,priorities
if priority names(i) -> (reply).s1 then start
document_priority = i
exit
finish
repeat
finish
if document_priority = -1 start
printstring(snl."Replies:")
cycle i = 1,1,priorities
printstring(" ".priority names(i))
repeat
newline
finish else exit
repeat
continue
option act(9):
if direction = out then printstring("Not required".snl) and continue
cycle
prompt("Kbytes: ")
read prompt reply(reply,no)
i = s to i(reply)
if reply = "?" or i < 1 or i > 10000 then c
printstring(snl."reply with estimate of total Kbytes of the file".snl) c
else exit
repeat
document_data length = i<<10
continue
option act(12):
option act(13):
option act(10):
if direction = out start
printstring(snl."Only for INcoming file transfers.".snl)
continue
finish
if i = 10 then document_ftp user flags = document_ftp user flags ! ANSI
if i = 12 then document_ftp user flags = document_ftp user flags c
! binary read only
if i = 13 then document_ftp user flags2 = document_ftp user c
flags2 ! text read only
continue
option act(11):
!Special Options.
if direction = in start
printstring(snl."Only for OUTgoing file transfers.".snl)
continue
finish
prompt("Value: ")
read prompt reply(reply,no)
to docstring(document,document_special options,reply)
continue
repeat
skip options:
document_header = "BINDOC:"
p = 0
flag = 0
flag = dspool(p,(5<<24)!264,addr(document))
if flag # 0 and flag # p_p1 then printstring("File Transfer System not available".snl) c
and return
if p_p1 = 0 and p_p2 > 0 start
printstring("NIFTP-B(80) Transfer queued, entry: T".itos(p_p2).snl)
term:
return if prompt input = no
cycle
printstring("Another transfer with ".docstring(document,document_external user). c
" at ".docstring(document,document_ftp alias)." ?".snl)
prompt(": ")
read prompt reply(reply,no)
return if reply -> ("N").s1
exit if reply -> ("Y").s1
printstring(snl."Reply YES if you wish to initialise another transfer ".snl. c
"with the same user on the same external system else reply NO".snl)
repeat
another pass = yes
document = new doc
-> another
finish else start
if p_p1 = 1 then fail("Local user not known !!!")
if p_p1 = 2 then fail("No free spooler descriptors.")
if p_p1 = 3 then fail("DTRANSFER/DCONNECT fails")
if p_p1 = 4 then fail("Unknown external system. ")
if p_p1 = 5 then fail("Transfer queue full.")
if p_p1 = 6 then fail("Bad params!")
if p_p1 = 7 then fail("Unaccepted mode of transfer")
if p_p1 = 8 then fail("Gateway FTP access barred, accreditation required.")
fail("Unknown failure")
finish
fail structure:
printstring("TRANSFER help requested or request not understood, The ")
if option fault check = no or help required = yes start
printstring("command is".snl." TRANSFER(SOURCE,SINK,MODE)".snl)
printstring("with substructure of SOURCE and SINK as either".snl)
printstring(" 1) A simple EMAS file name, or job name, or UKC device name".snl)
printstring("or 2) External System(External User,External User Pass)External Name".snl)
printstring(" where External Name is a file/job/device name at the External Site".snl)
finish
if option fault check = yes or help required = yes start
if help required = yes then printstring(snl."Options can ". c
"be included on an extended command. The ")
printstring("extended ".snl."Command is of the form :".snl. c
" Command:TRANSFER( SOURCE, SINK, MODE,option,option,option......)".snl. c
"Where 'option' is either 'keyword' or 'keyword(parameter)' .".snl)
finish
printstring(snl.message.snl)
return
integerfn get param(stringname sp, integer single param only)
string (128) ss,sr,st,sq,su,residual,remainder
result = 1 unless options string -> ss.("(").sp and ss = ""
options string = "" and result = 1 unless (sp -> sp.("),"). c
options string) or (sp -> sp.(")").options string and options string = "")
if options string # "" and single param only = yes then c
options string = ",".options string
result = 0 if options string = "" or single param only = yes
options string = "),".options string
residual = ""
remainder = ""
!What we have to do now is sort out in a string x,y(z),a(,b),c which
!part is actually parameter and which may be the next keyword.
cycle i = 1,1,options
cycle j = 2,1,length(option keys(i))
ss = option keys(i)
length(ss) = j
ss = "),".ss
if options string -> st.(ss).sr start
if ((sr -> sq.(",").su and sq = "") or (sr -> sq.("(").su c
and sq = "") or sr = "") start
if length(st) <= length(residual) or residual = "" start
!printstring("residual set to : ".st.snl)
residual = st
remainder = option keys(i); length(remainder) = j
remainder = ",".remainder.sr
exit if residual = ""
finish
finish
finish
repeat
if residual = "" and remainder # "" then exit
repeat
if remainder # "" start
options string = remainder
sp = sp.",".residual if residual # ""
finish else sp = sp.options string and options string = ""
!printstring("param : ".sp." remainder : ".options string.snl)
result = 0
end
end
externalroutine transfers(string (255) param)
constinteger queued = 1
constinteger unused = 0
constinteger unallocated = 0; !STREAM STATUS
constinteger allocated = 1; !DITTO
constinteger line active = 2; !DITTO
constinteger connecting = 3; !DITTO
constinteger disconnecting = 4; !DITTO
constinteger aborting = 5; !DITTO
constinteger suspending = 6; !DITTO
constinteger deallocating = 7; !DITTO
constinteger aborted = 8; !used by ftp line only
constinteger selected = 9; !USED ONLY FOR ftp STREAMS
constinteger awaiting sft = 10
constinteger sft sent = 11
constinteger awaiting stop = 12
constinteger stop sent = 13
constinteger rpos sent = 14
constinteger rneg sent = 15
constinteger stopack sent = 16
constinteger go sent = 17
constinteger receiving data = 18
constinteger transmitting data = 19
constinteger last block sent = 20
constinteger end of data sent = 21
constinteger quit sent = 22
constinteger end data ack sent = 23
constinteger p station = 0
constinteger full list = -1
constinteger current list = -2
constinteger rates = -3
constinteger open = 1
conststring (19)array status (0 : 24) = c
"Calling","Calling","Calling","Calling","Call closing with","Call closing with",
"Call closing with","Call closing with","Call closing with",
"Calling","Called by","Calling","Call closing with",
"Call closing with","Transferring with","Call rejected by","Call closing with",
"Transferring with","Transferring with","Transferring with",
"Transferring with","Transferring with","Call failing with",
"Transferring with","Transferring with"
record (lcf)arrayformat list cells af(1 : max documents)
record (linef)arrayformat larf(1 : max lines)
record (ftp stationf) arrayformat ftpsf(1: max stations)
recordformat aheadf (integer jobs,nkb)
record (aheadf)array ahead(1:MAX STATIONS)
record (lcf)arrayname list cells
record (lcf)array list cells copy(1:1000)
record (pointers f)name pointers
record (queuef)name queue
record (linef)arrayname ftp lines
record (ftp stationf) arrayname ftp stations
record (fhf)name file header
record (name f)name name entry
record (rf) re
record (document descriptorf)name document
integer header printed, my fsys, flag, i, j, k, next , lines, stations, found, allset, fault count, rate, hash length
integer station ptr, address cache addr
string (6) my user
string (87) entry,s
string (132) extra,ex1,ex2
string (6) line
integer actcon, active, busy, count, deferred,station specific, guest address set
byteintegerarray station set(1:max stations)
byteintegerarray station activity(1:max stations)
!***********************************************************************
!* *
!* THESE FUNCTIONS ALL USE A PACKED FORMAT OF DATE AND TIME OF THE *
!* FOLLOWING FORM. BITS ARE NUMBERED FROM 31 (MOST SIGNIFICANT) TO *
!* 0 (LEAST SIGNIFICANT) *
!* BITS USE *
!* 31-26 YEAR-70 (VALID FOR 1970-2033) *
!* 25-22 MONTH *
!* 21-17 DAY *
!* 16-12 HOUR *
!* 11- 6 MINUTE *
!* 5- 0 SECOND *
!* *
!***********************************************************************
stringfn s2(integer n)
!THIS FUNCTION RETURNS A TWO DIGIT DECIMAL VALUE FOR N
integer tens, units
tens = n//10
units = n-10*tens
result = tostring(tens+'0').tostring(units+'0')
end ; !OF S2
stringfn doc string(record (document descriptor f)name document,
byteintegername ptr)
if ptr = 0 then result = "" else c
result = string(addr(document_string space) + ptr)
end
!*
integer fn hashed(string (63) name)
integer i, pt, n, h
byte integer array x(0:15)
const byte integer array prime(1:7)= 23, 19, 11, 7, 5, 13, 17
pt = (addr(x(7))>>3)<<3
longinteger(pt) = 0
n = addr(name)
byteinteger(pt+i&7) = byteinteger(pt+i&7)!!byteinteger(n+i) for i = 0, 1, length(name)
h = length(name)*29
h = h+prime(i)*byteinteger(pt+i) for i = 1, 1, 7
result = h&hash length
end ; !of hashed
integer fn lookup hasht(string (63) name)
record (name f) name name entry
integer h
h = hashed(name)
if pointers_hasht(h)#-1 start
name entry == record(re_conad + pointers_hasht ( h ))
cycle
if name=name entry_name then result = name entry_host entry
exit if name entry_link = -1
name entry == record ( re_conad + name entry_link )
repeat
finish
result = 0
end ; !of lookup hasht
integer fn lookup host(string (63) name)
integer i
string (63) rest
{uctranslate or lc?}
i = lookup hasht(name)
if i#0 then result = i
unless name->(this ukac.".").rest start
i = lookup hasht(this ukac.".".name); !prefix uk.ac
if i#0 then result = i
if name->name.(".").rest then result = lookup hasht(name); !for arpa.
finish
result = 0
end ; !of lookup host
routine connect trans db(integername flag)
connect("FTRANS.CFILE",r!sh,0,0,re,flag)
!connect("TESTFILE",r,0,0,re,flag)
if flag # 0 and flag # 34 start
printstring("Cannot connect TRANSFER systems database".snl)
return
finish
flag = 0
file header == record(re_conad)
pointers == record(re_conad + file header_start)
lines = pointers_streams
stations = pointers_stations
hash length = pointers_hash length
ftp lines == array(re_conad + pointers_stream displ, larf)
ftp stations == array(re_conad + pointers_station displ,ftpsf)
list cells == array(Re_conad + pointers_link list displ, list cells af)
queue == record(Re_conad + pointers_queue displ)
address cache addr = re_conad + pointers_station addresses displ
end
routine fill(integer to length, front, stringname s,string (1) char)
integer i, j
if length(s) < to length start
j = to length - length(s)
cycle i = 1,1,j
if front = yes then s = char.s else s = s.char
repeat
finish
end
routine print doc details(integer document id,ptr,line,jobs,nkb)
string (87) t
integer size, this entry is guest
this entry is guest = no
entry = ""
s = "T".i to s((document id<<8)>>8)
fill(4,yes,s," "); entry = s
s = docstring(document,document_name)
if length(s) > 11 then length(s) = 11 else fill(11,no,s,".")
entry = entry." ".s
s = unpack date(document_date and time received)
length(s) = 5
entry = entry." ".s
s = unpack time(document_date and time received)
length(s) = 5
entry = entry." ".s
if line = 0 start
size = (document_data length+1023)>>10
if size > ftp stations(pointers_control entry)_limit or size > ftp stations(ptr)_ c
limit then deferred = yes and s = "Deferred on size" else s = "Queued for"
fill(17,no,s,".")
entry = entry." ".s
finish else start
s = status(ftp lines(line)_status)
fill(17,no,s,".")
entry = entry." ".s
finish
if ptr = pointers_guest entry start
entry = entry." [given address]"
this entry is guest = yes
guest address set = yes
finish else start
s = string(addr(ftp stations(ptr)_string space(0))+ftp stations(ptr)_shortest name)
if length(s) > 15 then length(s) = 15
fill(15,yes,s,".")
entry = entry." ".s
finish
if line = 0 start
s = i to s(jobs)
fill(10,yes,s,".")
entry = entry." ".s
s = itos(nkb)
fill(5,yes,s,".")
entry = entry." ".s
finish else start
if ftp lines(line)_status = transmitting data or ftp lines(line)_status c
= receiving data start
s = itos((ftp lines(line)_bytes transferred+1023)>>10)
fill(4,yes,s,"."); entry = entry." ".s." Kb"
if ftp lines(line)_status = receiving data then c
ENTRY = ENTRY." Received" else ENTRY = ENTRY." Sent"
finish
finish
printstring(entry.snl)
return unless this entry is guest = yes
printstring(" For: [".docstring(document,document_guest address)."]".snl)
end
integerfn document addr(integer param)
!***********************************************************************
!* *
!* *
!***********************************************************************
record (fhf)name file header
INTEGER I
i = (param&x'ff000000')>>24
connect("FTRANS.FTPLIST".itos(i),r!sh,0,x'00000080'!(i<<8),re,flag)
if flag # 0 and flag # 34 start
printstring("TRANLIST".itos(i)." conn fails ".itos(flag).snl)
result = 0
finish
file header == record(re_conad)
i = re_conad+file header_start+(param&x'ffffff'-1)* c
document entry size
result = I
end ; !OF INTEGERFN map DOCUMENT
routine print header
printstring("Doc_ Name_______ Submitted__ State____________". c
" Ext. System____ Ahead:Docs / Nkb".snl)
end
!FTP Station STATUS list.
!0 General accesss station
!1 PSS accreditation (bit 6) required
!5 Masked (ALIAS) but can be seen in TRANSFERS(.ALL) enquiries
!6 MASKED and is invisable even in TRANSFERS(.ALL) enquiry.
!7 As 6 but requires ACR 9 for access at all.
connect trans db(flag)
return if flag # 0
fault count = 0
again:
if fault count = 3 start
printstring("There is a 'hard' problem, please submit this monitor to Advisory".snl.snl)
monitor
return
finish
station specific = 0; allset = no
if param ->("?").extra and extra # "" then param = "FROMTRANSFERS".param c
and transfer(param) and return
if param = "?" or param = "HELP" or param = "help" start
printstring("The optional parameters to the Command TRANSFERS are as follows:".snl.snl)
printstring("i) No parameter. In this case all Transfer Requests outstanding for".snl)
printstring(" you will be listed together with a summary of the status of both the Local".snl)
printstring(" File Transfer System and the External File Transfer Systems for which ".snl)
printstring(" you have outstanding requests.".snl.snl)
printstring("ii) TRANSFERS('sys') where 'sys' is the name of an External System.".snl)
printstring(" In this case all Transfer Requests that you have outstanding for this".snl)
printstring(" particular system will be listed together with the status of the Local".snl)
printstring(" File Transfer System and that of the External File Transfer System in".snl)
printstring(" detail. Note that this can be issued regardless of whether you have".snl)
printstring(" Transfer Requests outstanding for the External System in question .".snl)
printstring(" For example TRANSFERS(ERCVAX) TRANSFERS(LIVUNIV.VAX2)".snl.snl)
printstring("iii) TRANSFERS('?key') This is a more general form of the above.".snl. c
" The '?' in '?key' indicates that a general search on the External".snl. c
" Host database is required with a search key of value 'key'. Once".snl)
printstring(" in this mode any number of searches with any number of keys can be".snl. c
" can be undertaken. Example TRANSFERS(?EDINBURGH)".snl.snl)
printstring("iv) TRANSFERS(.ALL) This command will give the status of the Local File".snl)
printstring(" Transfer System together with the status of all the External File Transfer".snl)
printstring(" Systems for which there are requests outstanding or in progress for any".snl)
printstring(" user. In effect it gives a complete work profile of the".snl)
printstring(" Local File Transfer system.".snl.snl)
return
finish
guest address set = no
if param = "RATES" or param = "rates" then station specific = rates
if param = "*" then station specific = full list
if param -> (".ALL").param or param -> (".all").param then station specific = current list
if station specific <= full list then all set = yes and param = ""
cycle i = 1,1,stations
station activity(i) = no
station set(i) = no!allset
repeat
if param # "" start
!We want to look at a specific NRS host.
i = lookup host(param)
if i # 0 then station specific = i and param = ""
finish
header printed = no
found = no
if param # "" start
printstring("Invalid parameter...further facilities available soon.".snl)
disconnect("FTRANS.CFILE",flag) and return
finish
my user = uinfs(1)
my fsys = -1
flag = dfsys(my user, my fsys)
if station specific = rates then -> just rates
!General query
cycle i = 1,1,lines
if ftp lines(i)_document # 0 start
station activity(ftp lines(i)_station ptr) = yes
if ftp lines(i)_status # selected and ftp lines(i)_document>>24 = my fsys start
if ftp lines(i)_user = my user start
document == record(document addr(ftp lines(i)_document))
if document_state # unused start
!An active transfer for this user
if station specific = 0 or ftp lines(i)_station ptr = station specific start
if header printed = no then print header and header printed = yes
print doc details(ftp lines(i)_document,ftp lines(i)_station ptr,i,0,0)
station set(ftp lines(i)_station ptr) = yes
found = yes
finish
finish
if ftp lines(I)_status = awaiting sft or c
RPOS sent <= ftp lines(i)_status <= STOPACK sent or (ftp lines(i)_station type # c
p station and receiving data <= ftp lines(i)_status <= c
end data ack sent) then station set(ftp lines(i)_station ptr) = yes c
and found = yes
finish
finish
finish
repeat
cycle i = 1,1,max documents
list cells copy(i) = list cells(i)
repeat
next = queue_head
cycle i = 1,1,stations
ahead(i) = 0
repeat
while next # 0 cycle
station ptr = list cells copy(next)_station ptr
unless 0< station ptr <= stations start
printstring("PROBLEM, (bad pointer ".itos(station ptr)." rechecking".snl)
header printed = no
fault count = fault count + 1
- > again
finish
station activity(station ptr) = yes
deferred = no
if station specific > full list start
if list cells copy(next)_document >> 24 = my fsys start
document == record(document addr(list cells copy(next)_document))
if document_user = my user start
if document_state # queued start
printstring("PROBLEM , (bad state ".itos(document_state).") rechecking!".snl)
fault count = fault count + 1
header printed = no
-> again
finish
if station specific = 0 or station ptr = c
station specific start
if header printed = no then print header and header printed = yes
print doc details(list cells copy(next)_document,list cells copy (next)_ c
station ptr,0,ahead(station ptr)_jobs, c
ahead(station ptr)_nkb)
station set(station ptr) = yes
found = yes
finish
finish
finish
if deferred = no start
ahead(station ptr)_jobs = ahead(station ptr)_jobs + 1
ahead(station ptr)_nkb = ahead(station ptr)_nkb + (list cells copy(next)_size+1023)>>10
finish
finish
next = list cells copy(next)_link
repeat
if station specific > full list start
if station specific = 0 then extra = "" else extra = " for ". c
string(addr(ftp stations(station specific)_string space(0)) c
+ ftp stations(station specific)_shortest name)
if found = no start
printstring("You have no FILE TRANSFER requests".extra.snl)
if station specific = 0 then -> out
finish
finish
count = 0
busy = no
active = no
if guest address set = yes then printstring(snl."NOTE no further". c
" details on <given address> requests provided.".snl)
cycle i = 1,1,lines
count = count + 1 if ftp lines(i)_status >= LINE active and ftp lines(i)_ c
station type = p station
repeat
if count >= ftp stations(pointers_control entry)_max lines - ftp stations(pointers_control entry)_q lines c
then busy = yes
printstring(snl."*Local Transfer Service is ")
unless ftp stations(pointers_control entry)_service = open then printstring("Closed, ") c
else printstring("Open, ") and printstring("Limited to ".itos(ftp stations(pointers_control entry)_limit)."kb ")
if busy = yes then printstring("[ All LINES ARE IN USE ]") else start
printstring("[Records start: ")
s = unpack date(ftp stations(pointers_control entry)_system loaded)
length(s) = 5
printstring(s." ")
s = unpack time(ftp stations(pointers_control entry)_system loaded)
length(s) = 5
printstring(s."]")
finish
newlines(1)
if station specific > 0 start
i = ftp stations(station specific)_shortest name
printstring(string(addr(ftp stations(station specific)_string space(0)) c
+ ftp stations(station specific)_shortest name)." : ")
s = string(addr(ftp stations(station specific)_string space(0)) c
+ ftp stations(station specific)_description)
if s -> ("~").s then s = s
printstring(s.snl)
printstring("Full Name : ".string(addr(ftp stations(station specific)_ c
string space(0)) + ftp stations(station specific)_name).snl)
printstring("Primary TS address : ")
extra = string(address cache addr+ftp stations(station specific)_address(1))
if extra -> ex1.("(").(",").(")").ex2 then extra = ex1.ex2
printstring(extra.snl)
printstring("Accepts transfers". c
" up to ".itos(ftp stations(station specific)_limit)."kb")
printstring("; maximum of ".itos(ftp stations(station specific)_max lines). c
" concurrent transfer(s).".snl)
printstring("Transaction Summary:")
if FTP stations(station specific)_seconds > 0 start
printstring(" {Last ".itos((ftp stations(station specific)_ c
bytes+1023)>>10)." kb transferred at average ")
rate =FTP stations(station specific)_bytes//FTP stations(station specific)_seconds
printstring(itos(rate)." bytes/second}")
finish
newline
printstring("A) with ".string(addr(ftp stations(station specific)_ c
string space(0)) + ftp stations(station specific)_shortest name)." as ". c
"responder to Local Transfer Requests".snl)
if ftp stations(station specific)_P transfers = 0 then c
printstring(" No Transfers.".snl) else start
printstring(" There have been ".itos(FTP stations(station specific)_P transfers)." transfers")
if ftp stations(station specific)_P mail > 0 then c
printstring(" ( ".itos(ftp stations(station specific)_P mail)." were MAIL )")
newlines(1)
printstring(" Total of ".itos( c
ftp stations(station specific)_P kb)." Kilobytes transferred ( ")
print(ftp stations(station specific)_P kb/ftp stations(station specific)_ c
P transfers,1,1)
printstring(" Kb/transfer )".snl)
finish
printstring("B) with Local Transfer Service as responder ". c
"to Transfer requests from ".string(addr(ftp stations(station specific)_ c
string space(0)) + ftp stations(station specific)_shortest name).snl)
if ftp stations(station specific)_last q response by us = -1 then c
printstring(" No record of a serviced call from ".string(addr( c
ftp stations(station specific)_string space(0)) + ftp stations( c
station specific)_shortest name).".".snl) else start
printstring(" Last serviced call from ".string(addr( c
ftp stations(station specific)_string space(0)) + ftp stations(station specific)_ c
shortest name)." was at ")
s = unpack date(ftp stations(station specific)_last Q response by us)
length(s) = 5
printstring(s." ")
s = unpack time(ftp stations(station specific)_last Q response by us)
length(s) = 5
printstring(s.snl)
finish
if ftp stations(station specific)_Q transfers = 0 then printstring( c
" No Transfers.") else start
printstring(" There have been ".itos(FTP stations(station specific)_Q transfers)." transfers")
if ftp stations(station specific)_Q mail > 0 then c
printstring(" ( ".itos(ftp stations(station specific)_Q mail)." were MAIL )")
newlines(1)
printstring(" Total of ".itos( c
ftp stations(station specific)_Q kb)." Kilobytes transferred ( ")
print(ftp stations(station specific)_Q kb/ftp stations(station specific)_ c
Q transfers,1,1)
printstring(" Kb/transfer )")
finish
newlines(2)
finish
if station specific = current list start
cycle i = 1,1,stations
if station activity(i) = no then station set(i) = no
repeat
finish
if station specific <= full list then station specific = 0
printstring("Ext. System____ Last Reply__ Last Call__ Line NOTES".snl)
if station specific # 0 then actcon = no and i = station specific and -> specific
just rates:
cycle i = 1,1,stations
continue if ftp stations(i)_address type = BASE type { do not look at DIRECTORY entries}
actcon = no
if station set(i) = yes and ftp stations(i)_status <6 start
specific:
s = string(addr(ftp stations(i)_string space(0)) + ftp stations(i)_shortest name)
fill(15,no,s,".")
entry = s
if station specific = rates start
if FTP stations(i)_seconds > 0 start
printstring(entry." Last ".itos((ftp stations(i)_ c
bytes+1023)>>10)." kb transferred at average ")
rate =FTP stations(i)_bytes//FTP stations(i)_seconds
printstring(itos(rate)." bytes/second")
newline
finish
continue
finish
if ftp stations(i)_last response = -1 then entry = entry." No Record" c
else start
s = unpack date(ftp stations(i)_last response)
length(s) = 5
entry = entry." ".s
s = unpack time(ftp stations(i)_last response)
length(s) = 5
entry = entry." ".s
finish
if station activity(i) = no start
printstring(entry); printstring(" ........... - IDLE, no transfer requests.".snl)
entry = ""
actcon = yes
finish
active = no
cycle j = 1,1,lines
if ftp lines(j)_document # 0 and ftp lines(j)_station ptr = i start
if ftp lines(j)_status = connecting or ftp lines(j)_status = sft sent c
or ftp lines(j)_status = selected then active = yes and exit
finish
repeat
if active = no or station activity(i) = no start
if ftp stations(i)_last call # 0 and station activity(i) = yes start
s = unpack date(ftp stations(i)_last call)
length(s) = 5
entry = entry." ".s
s = unpack time(ftp stations(i)_last call)
length(s) = 5
entry = entry." ".s
finish else entry = entry." ..........."
finish else entry = entry." ..........."
if ftp stations(i)_last call # 0 and ((active = no and station activity(i) = yes) c
or active = yes) start
s = " ".i to s(ftp stations(i)_connect attempts)." Calls since last reply."
entry = entry." - ".s
printstring(entry.snl); actcon = yes
unless active = yes start
if ftp stations(i)_connect retry time = 0 then s = c
"Will re-call in a few seconds." else start
s = "Will re-call within "
k = ftp stations(i)_connect retry time
if k = 1 then s = s."a minute." else s = s.itos(k)." mins."
finish
spaces(43); printstring("- ".s.snl)
finish
finish
cycle j = 1,1,lines
line = i to s(j)
fill(3,yes,line," ")
line = line." "
if ftp lines(j)_document # 0 and ftp lines(j)_station ptr = i start
if ftp lines(j)_status = selected or ftp lines(j)_status = c
connecting or ftp lines(j)_status = sft sent start
document == record(document addr(ftp lines(j)_document))
s = line." Calling for "
if document_user = my user then s = s."you." else if c
document_user = "MAILER" then s = s."MAIL." else s = c
s."another user."
if actcon = no start
entry = entry." ".s
printstring(entry.snl); actcon = yes
finish else spaces(41) and printstring(s.snl)
finish else if ftp lines(j)_status = stop sent or c
ftp lines(j)_status = go sent or (ftp lines(j)_station type = c
p station and receiving data <= ftp lines(j)_status <= c
end data ack sent) start
s = line." Currently active for "
document == record(document addr(ftp lines(j)_document))
if document_user = my user then s = s."you" else if c
document_user = "MAILER" then s = s."MAIL." else c
s = s."another user."
if actcon = no start
entry = entry." ".s
printstring(entry.snl); actcon = yes
finish else spaces(41) and printstring(s.snl)
finish else if ftp lines(j)_status = awaiting sft or c
RPOS sent <= ftp lines(j)_status <= STOPACK sent or (ftp lines(j)_station type # c
p station and receiving data <= ftp lines(j)_status <= c
end data ack sent) start
s = line." External call active for "
document == record(document addr(ftp lines(j)_document))
if document_user = my user then s = s."you" else if c
document_user = "MAILER" then s = s."MAIL." else c
s = s."a user."
if actcon = no start
entry = entry." ".s
printstring(entry.snl); actcon = yes
finish else spaces(41) and printstring(s.snl)
finish else if connecting < ftp lines(j)_status < selected start
if actcon = no start
entry = entry." ".line." Call closing."
printstring(entry.snl); actcon = yes
finish else spaces(41) and printstring(line." Call closing.".snl)
finish
finish
repeat
if actcon = no start
if station activity(i) = yes start
if busy = yes then entry = entry." - IDLE, Local Transfer System busy." c
else entry = entry." - IDLE, deferred requests only."
printstring(entry.snl)
finish
finish
-> out if station specific # 0
finish
repeat
out:
disconnect("FTRANS.CFILE",flag)
disconnect("FTRANS.FTPLIST".itos(my fsys),flag)
end ; !Of routine TRANSFER
endoffile