/*  Shelter WPL Mailers Manager    Williamson */
v="$VER: Shelter Rexx Shelter Mailer Manager Williamson 56.03"
/* OPTIONS */
do_outs=0   /* if 1, flocvt will queue .OUT files */
debug=0
xfix=1
options results
options failat 99
signal on syntax
signal on halt
signal on ioerr
signal on break_c
signal on break_d

if ~show('L', "rexxsupport.library") then
  if ~addlib("rexxsupport.library", 0, -30, 0) then do
    say "Couldn't access rexxsupport.library !"
    exit 20
  end
if ~show('L', "rexxdossupport.library") then
  if ~addlib("rexxdossupport.library", 2, -30, 0) then do
    say "Couldn't access rexxdossupport.library !"
    exit 20  
  end
if ~show('L', "hGRexxSupport.library") then
  if ~addlib("hGRexxSupport.library", 2, -30, 0) then do
    say "Couldn't access hGRexxSupport.library !"
    exit 20
  end
if (left(ReadVar('KickStart',"R"),2)) < 37 then do
  say 'Sorry, AmigaDOS Release 2 or higher is required to use Shelter'
  exit 20
end
if ~show("L", "xferq.library") then
  if ~addlib("xferq.library", 0, -30, 0) then do
    say "Couldn't access xferq.library !"
    exit 20
  end
x=pragma("W","NULL")
Address COMMAND "CD MAIL:"
if RC~=0 then do
  say 'Where is MAIL:?'
  exit 40
end
wpath='CFG:WPL/'
log=show('P',"ROOFLOG")
wfhost=ReadVar('WFHOST')=="TRUE"
pktpri=55
CLS='0C'x; CSI='9b'x;OFF=CSI||'0m';BOLD=CSI||'1m';ULINE=CSI||'4m';ITALICS=CSI||'3;40m'

/* get Shelter Mailer Name */
smver=ReadVar('SMVER',"R")
shelter=ReadVar("SHELTER","R")
if shelter="" | shelter = "SHELTER" then do
  Say "No Shelter Mailer available"
  u_shelter="*** NO SHELTER ***"
  signal usage
end
call setup(shelter)
XQ_NOTHING=0;XQ_DELETE=1;XQ_TRUNCATE=2;XQ_IMMEDIATE=4;XQ_SENDLATER=8
DTPRI_HXT=60;DTPRI_CRASH=50;DTPRI_DIRECT=30;DTPRI_NORM=0;DTPRI_HOLD=-50

fontsize=8;havewin=0;DoUnLoad=0
PARSE UPPER ARG WHAT WHERE HOW
  if WHAT="" | WHAT="?" then signal usage
Select
  when WHAT="INIT" then do
    call GetVariables
  end
  when WHAT="CALL" then do
    if WHERE="" then signal callusage
    call dial(WHERE,HOW)
  end
  when WHAT="RESTART" then do
    call openwin("P")
    call closemailer(WHAT)
    call closelogs
    options prompt "Generate? (y/N) "
    parse pull ans
    if upper(ans)="Y" then do
      Address REXX GetClip('REXXDIR')'/GenMailer.rexx' u_shelter
      if RC~=0 then exit RC
    end
    call GetVariables()
    if ~DoUnLoad then call raisemailer()
    say "Command: "what" completed"
  end
  when what="AUTO" then do
    call GetVariables()
    call openpscr()
    call openwin("P")
    call loadlogproc()
    call raisemailer()
    call flocvt
    boss_site=GetClip("BOSS")
    parse var boss_site System number
    call dial(System,number,"S")
    if u_shelter="UMBRELLA" then do
      call closemailer(WHAT)
      call closelogs
      call closepscr
    end
  end
  when what="AUTOX" then do
    call GetVariables()
    call openpscr()
    call openwin("P")
    call loadlogproc()
    call raisemailer()
    boss_site=GetClip("BOSS")
    parse var boss_site System number
    call dial(System,number,"S")
    if u_shelter="UMBRELLA" then do
      call closemailer(WHAT)
      call closelogs
      call closepscr
    end
  end
  when WHAT="KILL" then do
    if WHERE="" then signal callusage
    call openwin("S")
    call killdial(WHERE)
  end
  when WHAT="OPENSTATUS" then call openstatus(WHERE)
  when WHAT="CLOSESTATUS" then call closestatus(WHERE)
  when WHAT="EXIT" then do
    call openwin("S")
    call closemailer(WHAT)
    call closelogs
    call closepscr
  end
  when WHAT="FLOCVT" then do
    call openwin("S")
    call flocvt()
    say "Command: "what" completed"
  end
  when WHAT="ADDWORK" then do
    call openwin("P")
    call addwork(WHERE,HOW)
    say "Command: "what" completed"
  end
  when WHAT="POLL" then do
    call openwin("S")
    call dopolls(WHERE)
    say "Command: "what" completed"
  end
  when WHAT="CLEAN" then do
    call openwin("P")
    call cleanxq()
    say "Command: "what" completed"
  end
  when WHAT="START" then do
    if WHERE ~="" & WHERE ~="WHERE" then call setup(WHERE)
    call GetVariables()
    call openpscr()
    call openwin("P")
    call loadlogproc()
    call raisemailer()
    call addwork("BADPASSWORD","CFG:PASSWORD.BAD L 75")
    if exists(rexxdir||'Sctl.rexx') then address AREXX rexxdir||'Sctl.rexx'
    say "Command: "what" completed"
  end
  otherwise Say 'Unknown command:'what
end /*select*/
/*
if havewin=1 then do
  call close('STDIN')
  call close('STDOUT')
end
*/
exit 0

loadlogproc:
  if ~showlist('p','LOGPROC') then do
    Address COMMAND "run >nil: logproc"
    say "Waiting for LogProc Port"
    Address COMMAND "waitforport LOGPROC"
    say "Log port ready"
  end
  if ~showlist('p','LOGPROC') then do
    say "Unabled to access LOGPROC"
    exit 10
  end
return

raisemailer:
  logfile=GetClip('LOGFILE')
  if logfile="" then logfile="MAIL:Shelter.LOG"
  Say  "Opening "logfile
  Address "LOGPROC"
  'OpenLog' file 'f' logfile

  logwindow=GetClip('LOGWINDOW')
  if index(logwindow,":")=0 then 'AddLogGroup' fgroup file
  else do
    logwindow=logwindow||"/SCREEN"||GetClip('SCREEN')
    Say  "Opening "logwindow
    'OpenLog' fwindow 'w' logwindow
    'AddLogGroup' fgroup file fwindow
  end
  Address
  slave=0
  PutLog('Opened log 'logfile date())

  slave=1
  if show('P',mport||slave) then do
    say mport||slave 'already active'
    exit 10
  end
  if ~show('p',"sushi_CAS_port") then do
    PutLog('Loading Sushi')
    address COMMAND "Run Sushi <>NULL: ON NOPROMPT ASKSAVE"
    call SetCLip('MYSUSHI',"TRUE")
  end

  PutLog('Loading 'u_shelter' Mailer')
  pcmd="ChangeTaskPri 1"||'0a'x
  scmd="Stack 50000"||'0a'x

  do i=1 to wscount
    parse var wsrc.i wscript.i '.' x
    lcmd='LoadScript' lower(wscript.i) wpath||wsrc.i
    cmd=scmd||pcmd||lcmd
    address COMMAND cmd
    stat=RC
    if stat ~=0 then do
      PutLog(lcmd 'returned' stat', did you note the error or forget to generate the Mailer?')
      DoUnLoad=1;signal unloadscripts
      exit
    end
  end
  PutLog('Launching 'u_shelter'0')
  cmd=scmd||pcmd||'Launch 'u_shelter'0 'l_shelter'!startup 0 30000'
  address COMMAND cmd
  stat=RC
  if stat ~=0 then PutLog(cmd 'returned' stat)
return 0

closemailer:
  call putlog('Closing slaves')
  if u_shelter~="UMBRELLA" then ports=GetClip('SLAVES')
  else ports=1
  do i=ports to 1 by -1
    if show('p',mport||i) then do
      call PutLog('Closing:'mport||i)
      address VALUE mport||i
      'Set exit 'arg(1)
      call delay(10) 
      'ABORT'
      do while show('p',mport||i)
        call delay(10)
      end
    end
    call delay(100)
  end
unloadscripts:
  call putlog('Flushing mailer')
  do i=1 to wscount
    parse var wsrc.i wscript.i '.' x
    ulcmd='LoadScript' lower(wscript.i) '""'
    address COMMAND ulcmd
    stat=RC
    if stat~=0 then call PutLog(ulcmd 'returned' stat)
    call closestatus(i)
  end
  if show('P','sushi_CAS_port') then do
    if GetCLip('MYSUSHI')="TRUE" then do
      call PutLog("Closing Sushi")
      address COMMAND "sushi OFF"
    end
  end
return 0

closelogs:
  call putlog('Closing logs')
  address "LOGPROC"
  'Closelog 'file
  logwindow=GetClip('LOGWINDOW')
  if index(logwindow,":") > 0 then 'CloseLog' fwindow
  'RemLogGroup 'fgroup
return

closestatus:
slave=arg(1)
if u_shelter="UMBRELLA" then slave=1
address "LOGPROC"
'Closelog 'window||slave
'RemLogGroup' wgroup||slave
Address
return 0

openstatus:
if u_shelter="UMBRELLA" then slave=1
  else slave=arg(1)
if ~show('P',mport||slave) then do
  PutLog(mport||slave 'not active')
  exit 10
end
rws_specs=GetClip('WSPEC')
if rws_specs="" then rws_specs="NOSIZE/NODEPTH/INACTIVE"
rws_x=0 ; rws_y=10 ; rws_chars=80 ; rws_lines=7 ; rws_text='@f3@R'
rws.0='   Status'copies(" ",53)    ||       'H_Freqs'copies(" ",10)
rws.1=' Response'copies(" ",13)'Login'copies(" ",35)'R_Freqs'copies(" ",10)
rws.2='   Baud'copies(" ",13)'H_Adr'copies(" ",35)'Inbound'copies(" ",10)
rws.3='   Number'copies(" ",13)'R_Adr'copies(" ",35)'Domain'copies(" ",10)
rws.4=' Password'copies(" ",13)'Sysop'copies(" ",52)
rws.5='  Session'copies(" ",13)'H_Ofr'copies(" ",52)
rws.6=' Protocol'copies(" ",13)'R_Ofr'copies(" ",52)
p.1="p.status   @1,10,53 @R"
p.2="p.response @2,10,13 @R"
p.3="p.baud   @3,10,13 @R"
p.4="p.number   @4,10,13 @R"
p.5="p.password @5,10,13 @R"
p.6="p.session  @6,10,13 @R"
p.7="p.protocol @7,10,13 @R"
p.8="p.login   @2,28,35 @R"
p.9="p.host  @3,28,35 @R"
p.10="p.remote  @4,28,35 @R"
p.11="p.rsysop   @5,28,52 @R"
p.12="p.hoffer   @6,28,52 @R"
p.13="p.roffer   @7,28,52 @R"
p.14="p.hfreqs   @1,70,10 @R"
p.15="p.rfreqs   @2,70,10 @R"
p.16="p.inbound  @3,70,10 @R"
p.17="p.domain   @4,70,10 @R"
positions=17

if u_shelter~="UMBRELLA" then do
  slavewindows=getwindows()
  if slavewindows~=0 then rws_y=rws_y+(w_height(rws_lines)*slavewindows)
end
Address VALUE mport||slave
'String $(device) $(unit) $(modem)'
minfo=mport||slave strip(RESULT)
xspec='RAW:'rws_x'/'rws_y'/'w_width(rws_chars)'/'w_height(rws_lines)'/The 'u_shelter' Mailer v'smver' 'minfo'/'rws_specs'/SCREEN'GetClip('SCREEN')
if debug then do
  PutLog("MINFO  :"minfo)
  PutLog("WINDOW :"window)
  PutLog("WGROUP :"wgroup)
  PutLog("XSPEC  :"xspec)
end
address "LOGPROC"
'OpenLog' window||slave "'w'" xspec
'AddLogGroup' wgroup||slave window||slave
do i=0 to rws_lines
  'PutLine' wgroup||slave  '@'i+1',1' rws_text||rws.i||copies(" ",rws_chars-length(rws.i))
end

Address VALUE mport||slave
do i=1 to positions
  'Set' word(p.i,1) '"'subword(p.i,2)'"'
end
Address
return 0

getwindows: procedure expose l_shelter
  slavewindows=0
  Address LOGPROC 'Show "l"'
  logs=RESULT
  if words(logs)=0 & slave > 1 then return slave-1
  if words(logs)=0 then return 0
  do i=1 to words(logs)
    if index(word(logs,i),l_shelter'ss') > 0 then slavewindows=slavewindows+1
  end
return slavewindows

dial:
System=arg(1)
Number=arg(2)
lmode=arg(3)
if Number="NUMBER" then Number=""
else number="NUMBER "Number
if u_shelter="ROOF" then address COMMAND "RUN >NIL: CALL" System Number
else do
  if lmode="S" then Address "REXX" GetClip('REXXDIR')"/Scall" System Number
  else Address "AREXX" GetClip('REXXDIR')"/Scall" System Number
end
return

killdial:
if ~datatype(arg(1),'MIXED') then site_address=make5d(arg(1))
else site_address=arg(1)
call SetClip("S"||site_address,'abort')
PutLog('Call to 'site_address' will be aborted on next attempt')
return

callcleanup:
call PutLog('Removing 'site_address' from dial queue')
call SetClip("S"||site_address,"")
return 0

make5d: procedure expose dd z n f p
da=arg(1)
select
  when index(da, "#") > 0 then parse var da dd "#" z ":" n "/" f "." p
  when index(da, ":") > 0 then parse var da z ":" n "/" f "." p
  when index(da, "/") > 0 then parse var da n "/" f "." p
  when index(da, ".") > 0 then parse var da f "." p
  when left(da, 1)="." then parse var da "." p
  otherwise parse var da f .
end
myaddress.domain=GetClip('DOMAIN')
cfgaddress=GetClip('HOST.ADDRESS.'||myaddress.domain)
parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point

if p="" | p='P' then p='0'
if n="" | n='N' then n=myaddress.net
if f="" | f='F' then f=myaddress.node
if z="" | z='Z' then z=myaddress.zone
if dd="" | dd='DD' then do
  dl=GetClip('DOMAINLIST')
  dd=0
  x=find(dl,z)
  if x~=0 then dd=word(dl,x-1)
  if dd=0 then dd=myaddress.domain
end

if ~datatype(z,'n') | ~datatype(n,'n') | ~datatype(f,'n') | ~datatype(p,'n') then do
  call PutLog('make5d: Invalid address ['da']')
  return 0
end
drop da
if myaddress.domain"#"cfgaddress=dd'#'z':'n'/'f'.'p
then p=0
return(dd'#'z':'n'/'f'.'p)

flocvt:
xpri.H=0;xpri.C=50;xpri.D=30;xpri.N=0;xpri.F=0;xpri.O=0
outdir=addslash(dequote(GetClip('OUTDIR')))
flodir=addslash(dequote(GetClip('FLODIR')))
call PutLog('Searching for FLO files in' flodir)
Address COMMAND 'LIST >t:flofilelist 'flodir||'#?.#?.#?.#?.?LO quick nohead'
if word(statef("T:flofilelist"),2)=0 then do
  call PutLog('No ?LO files in' outdir)
  Signal scanout
end

if ~open('flolist',"t:flofilelist",'R') then do
  call PutLog("Error opening 4D .FLO list")
  return 10
end
i=0
do forever
  Line=Upper(strip(space(ReadLn('flolist'),1),'B'))
  if EOF('flolist') then Leave
  if Line="" then iterate
  i=i+1
  node.i=Line
  parse var Line flonode.i.zone "." flonode.i.net "." flonode.i.node "." flonode.i.point "." junk
  flonode.i.domain=find_domain(flonode.i.zone)
  flonode.i.pri="0"

  floadr=flonode.i.zone":"flonode.i.net"/"flonode.i.node"."flonode.i.point

  ftype=left(junk,1);if pos(ftype,'H C D N F')>0 then flofile.i.pri=xpri.ftype
end
call close('flolist')
if i=0 then do
  call PutLog("Error: No 4D ?LO Files found in" flodir)
  drop flonode floadr
  call delete("T:flofilelist")
  return 0
end
flonode.numnodes=i
do anode=1 until anode=flonode.numnodes
  drop flags
  floadr=flonode.anode.zone':'flonode.anode.net'/'flonode.anode.node'.'flonode.anode.point
  call PutLog("Converting" node.anode "for" floadr)
  jnode=left(node.anode,length(node.anode)-3)
  floname=upper(flodir||jnode||Left(right(node.anode,3),1)||"LO")
  flonode.anode.domain=find_domain(flonode.anode.zone)
  site=flonode.anode.domain||"#"||flonode.anode.zone||":" ,
    ||flonode.anode.net||"/"||flonode.anode.node||"."||flonode.anode.point
  if u_shelter="ROOF" then myaddress.domain=GetClip('DOMAIN')
  else myaddress.domain=GetClip('FTNDOMAIN')
  cfgaddress=GetClip('HOST.ADDRESS.'||myaddress.domain)
  parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point

  err=0
  if ~exists(floname) then do
    call PutLog("Error: Can't find "floname)
    call drop_vars
    err=1
  end
  else if ~Open('flofile',floname,'R') then do
    call PutLog("Error: Can't open" floname)
    call drop_vars
    err=1
  end

  site_address=XfqGetAddress(site)
  if ~err then do
    do forever
      Line=upper(ReadLn('flofile'))
      if eof('flofile') then Leave
      if Line="" then Iterate

      flags=XQ_NOTHING
      if (LEFT(Line,1)="#") then do
        flags=XQ_TRUNCATE
        Line=DELSTR(Line,1,1)
      end;else if (LEFT(Line,1)="^") | (LEFT(Line,1)="-") then do
        flags=XQ_DELETE
        Line=DELSTR(Line,1,1)
      end;else if (LEFT(Line,1)="@") then do
        flags=XQ_NOTHING
        Line=DELSTR(Line,1,1)
      end
      if ~exists(Line) then do
        call PutLog("File "Line" No Longer Exists")
        Iterate
      end

      if right(Line,4) = ".TIC" then do
        flags=XQ_DELETE
        sendas=get_fn(Line)
      end;else if right(Line,2)="UT" then do
        Line=move_out(Line)
        sendas=get_packetname()

        if Left(right(Line,3),1)="C" then t.pri=DTPRI_HXT
        if Left(right(Line,3),1)="H" then t.pri=DTPRI_HOLD
        if Left(right(Line,3),1)="D" then t.pri=DTPRI_DIRECT
        if Left(right(Line,3),1)="N" then t.pri=DTPRI_NORM
        if Left(right(Line,3),1)="F" then t.pri=flonode.anode.pri
      end;else do
        parse var Line x '.' x '.' x '.' x '.' ext
        if ext="" then do
          sendas=get_fn(Line)
          flags=XQ_NOTHING
          t.pri=flonode.anode.pri
        end;else do
          tmpext=upper(left(ext,2))
          if datatype(right(ext,1),'n') & (tmpext="MO" | tmpext="TU" | tmpext="WE" | tmpext="TH" | tmpext="FR" | tmpext="SA" | tmpext="SU")  then do
            sendas=UPPER(d2x(65536+myaddress.net-flonode.anode.net,4)||d2x(65536+myaddress.node-flonode.anode.node,4)||'.'ext)
            flags=XQ_DELETE
            t.pri=flonode.anode.pri
          end
        end
        drop ext x
      end
      if xfix then do
        call PutLog("File "line" not in "site" queue, adding as "sendas)
        if XfqAddWorkQuick(site,Line,sendas,t.pri,flags) then call PutLog("File "line" not in "site" queue, adding as "sendas)
        else call PutLog("File "line" already queued for "site)
      end;else do
        QUERY.XQ_NAME=line
        QUERY.XQ_SITE=site_address
        work=NULL
        work=XfqFindWork(QUERY)
        if work=NULL then do
          call PutLog("File "line" not in "site" queue, adding as "sendas)
          XfqAddWorkQuick(site,Line,sendas,t.pri,flags)
        end;else call XfqUnlockWork(work)
      end
    end /*forever*/
  end /* flofile */
  call close('flofile')
  call delete(floname)
  call XfqFlushQueue(site_address)
  call XfqDropObject(site_address)  
  if ~xfix & work~=NULL then call XfqDropObject(work)  
end
call XfqClose()
call drop_vars
call delete("T:flofilelist")
scanout:
call PutLog('Searching for .?UT files in' outdir)
Address COMMAND 'LIST >t:outlist 'outdir||'#?.#?.#?.#?.?UT quick nohead'
if word(statef("T:outlist"),2)=0 then do
  call PutLog('No ?UT files in' outdir)
  Return
end
if ~open('outs',"t:outlist",'R') then do
  call PutLog("Error opening 4D .?UT list")
  return 10
end
do while ~eof('outs')
  outfile=upper(readln('outs'))
  if outfile="" then iterate
  parse var outfile oz '.' on '.' of '.' op '.' ext
  if ~do_outs & ext="OUT" then do
    PutLog('Skipping 'outfile)
    Iterate
  end

 xtype=left(ext,1);if pos(xtype,'H C D N O')>0 then flonode.i.pri=xpri.xtype
  else do
    call PutLog('ERROR: cannot queue 'outfile)
    Iterate
  end
  drop xtype
  call addwork(oz':'on'/'of'.'op,outdir||outfile "D" flonode.i.pri)
end  
call delete("T:outlist")
return

move_out:
  call makedir(outdir||"PKT")
  newline=outdir||"PKT/"get_fn(arg(1))
  Address COMMAND 'Copy 'arg(1) newline
  call delete(arg(1))
return newline

addwork:
site_address=arg(1)
qaz=space(arg(2),1)
parse var qaz file disposition priority .
PutLog('Addwork:'site_address file disposition priority)
if ~datatype(site_address,"MIXED") then do
isftn=1;site_address=make5d(site_address)
end;else do
isftn=0;site=site_address
end
if site_address=0 then return
if file="" | ~(exists(file)) then do
  PutLog('Cannot find ['file']')
  return 1
end
file=upper(file)
select
  when disposition="D" then flags=XQ_DELETE
  when disposition="T" then flags=XQ_TRUNCATE
  when disposition="L" then flags=XQ_NOTHING
  otherwise flags=XQ_NOTHING
end
if datatype(priority,"MIXED") then do
  priority=value("DTPRI_"priority)
  prispec=1
end;else do
  prispec=0
  select
  when priority > 50 then nop
  when priority > 30 then priority=DTPRI_CRASH
  when priority > 0 then priority=DTPRI_DIRECT
  when priority=0 then priority=DTPRI_NORM
  when priority=-50 then priority=DTPRI_HOLD
  otherwise priority=DTPRI_CRASH
  end
end
if ~isftn then sendas=get_fn(file)
else do
  if right(file,4)=".CUT" | right(file,4)=".DUT" | right(file,4)=".HUT" | right(file,4)=".OUT" then do
    sendas=get_packetname()
    flags=XQ_DELETE
  end
  else if right(file,4)=".PKT" then do
    sendas=get_fn(file)
    flags=XQ_DELETE
    if ~prispec then priority=DTPRI_HXT
  end
  else if right(file,4)=".TIC" then do
    sendas=get_fn(file)
    flags=XQ_DELETE
  end;else do
    parse var file td'.'tz'.'tn'.'tf'.'tp'.'ext .
    if ext ~= "" then call addarcmail
    else do
      parse var file tz'.'tn'.'tf'.'tp'.'ext .
      if ext ~= "" then call addarcmail
      else sendas=get_fn(file)
    end
    drop td tz tn tf tp ext tmpext j
  end
  dd=find_domain(z)
  site=dd||"#"||z||":"||n||"/"||f||"."||p
end
site_address=XfqGetAddress(site)
if xfix then do
  if ~XfqAddWorkQuick(site,file,sendas,priority,flags) then call PutLog("File "file" already queued")
  else do
    if isftn then call PutLog('Queued 'file' as 'sendas' for 'dd'#'z':'n'/'f'.'p' Pri:'priority 'Dsp:'flags)
    else call PutLog('Queued 'file' as 'sendas' for 'site' Pri:'priority 'Dsp:'flags)
  end
end;else do
  QUERY.XQ_NAME=file
  QUERY.XQ_SITE=site_address
  work=NULL
  work=XfqFindWork(QUERY)
  if work=NULL then do
    PutLog("File "file" not in site queue, adding")
    XfqAddWorkQuick(site,file,sendas,priority,flags)
  end;else do
    PutLog("File "file" already queued")
    if work ~=NULL then call XfqUnlockWork(work)
  end
  /*call XfqDropObject(work)  */
end
call XfqFlushQueue(site_address)
call XfqDropObject(site_address)  
if ~xfix & work ~=NULL then do
  if isftn then call PutLog('Queued 'file' as 'sendas' for 'dd'#'z':'n'/'f'.'p' Pri:'priority 'Dsp:'flags)
  else call PutLog('Queued 'file' as 'sendas' for 'site' Pri:'priority 'Dsp:'flags)
end
call XfqClose()
return

addarcmail:
if u_shelter="ROOF" then myaddress.domain=GetClip('DOMAIN')
else myaddress.domain=GetClip('FTNDOMAIN')
cfgaddress=GetClip('HOST.ADDRESS.'||myaddress.domain)
parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point
tmpext=upper(left(ext,2))
if datatype(right(ext,1),'n') & (tmpext="MO" | tmpext="TU" | tmpext="WE" | tmpext="TH" | tmpext="FR" | tmpext="SA" | tmpext="SU")  then do
sendas=UPPER(d2x(65536+myaddress.net-tn,4)||d2x(65536+myaddress.node-tf,4)||'.'ext)
flags=XQ_DELETE
return 1
end
return 0

dopolls:
  minpri=arg(1)
  if minpri="" | minpri='MINPRI' then minpri=0
  else do
    minpri=value("DTPRI_"minpri)-1
    PutLog('Polling only Priority >'minpri)
  end
  call PutLog('Scheduling Polls')
  sitelist=XfqGetSiteList()
  call XfqWalkSession(sitelist,sitearray)
  if sitearray.numentries=1 then call PutLog("There is 1 site in the queue")
    else call PutLog("There are "sitearray.numentries" sites in the queue")
  do loop = 1 to sitearray.numentries
    MaxPri=XfqMaxSitePri(sitearray.loop)
    addrtags.XQ_Mandatory=511
    addrtags.XQ_Optional=511
    System = upper(XfqPutAddress(sitearray.loop,addrtags))
    if System="BADPASSWORD" then Iterate
    PutLog("Site:"System" Pri:"MaxPri)

    if (MaxPri<-1)|(MaxPri>120) then Iterate   

    if System="BADADDRESS" then iterate
    if System~="" then do
      if MaxPri>MinPri then do
        call PutLog('Calling:' System)
        call dial(System)
      end;else do
        call PutLog('Not calling: 'System' Pri:'MaxPri)
      end
    end
  end
  call XfqDropObject(sitelist)  
  call XfqClose()
return 0


cleanxq:
  sitelist=XfqGetSiteList()
  call XfqWalkSession(sitelist,sitearray)
  call PutLog("There are "sitearray.numentries" sites in the queue")
  do loop = 1 to sitearray.numentries
    addrtags.XQ_Mandatory = 511 /* XQADDR_ANYTHING */
    addrtags.XQ_Optional = 511  /* XQADDR_ANYTHING */
    System = XfqPutAddress(sitearray.loop,addrtags)
    call XfqWalkQueue(sitearray.loop,thestem)
    call PutLog("There are "thestem.NUMENTRIES" files for "System)
    do i=1 to thestem.NUMENTRIES
      call PutLog("Sending "thestem.i.NAME" as "thestem.i.ASNAME" at priority "thestem.i.PRI) 
      if ~EXISTS(thestem.i.NAME) then do
        call PutLog("File "thestem.i.NAME" does not exist")
        FINDIT.XQ_NAME = thestem.i.NAME
        FINDIT.XQ_SITE = sitearray.loop
        work = XfqFindWork(FINDIT)
        if(work=NULL) then call PutLog("Someone got to it before us!")
        else do
          call XfqRemoveWork(work)
/*          call XfqDropObject(work)  */
        end
      end
    end
  end
  call XfqDropObject(sitelist)  
  call XfqClose()
return thestem.NUMENTRIES

getakey:
  options PROMPT "Hit a key"
  parse pull junk
return

get_packetname:
pktspec="CFG:packet_spec"
if ~open('out',pktspec,'R') then call PutLog("Can't read "pktspec)
else do
  packet_spec=readln('out')
  call close('out')
  drop out
end
tspec=left(date(),2)||compress(time(),":")
if (tspec=packet_spec) then tspec=tspec+1
do while exists(outdir||""||tspec".PKT")
  tspec=tspec+1
end
if ~open('out',pktspec,'W') then call PutLog("Can't write new "pktspec)
else do
  call writeln('out',tspec)
  call close('out')
  drop out
end
return(tspec||".PKT")

get_fn: procedure
if LastPos('/', arg(1)) ~=0 then return SubStr(arg(1), LastPos('/', arg(1)) + 1)
  else if LastPos(':', arg(1)) ~=0 then return SubStr(arg(1), LastPos(':', arg(1)) + 1)
    else return arg(1)

find_domain: procedure
dl=GetClip('DOMAINLIST')
dz=FIND(dl,arg(1))
if dz=0 then return GetClip('DOMAIN')
else return strip(word(dl,dz-1))

drop_vars:
drop tonode. flonode. hisaddress. work err line
drop floadr site site_address i file pktname floname sendas flags disposition priority
return 0

GetVariables: procedure expose envpath u_shelter
/* copy ENV variables to Clips */
say "Loading environment"
mv.1="SCREEN    1"
mv.2="LOGFILE     0"
if u_shelter="ROOF" then mv.3="DOMAIN    1"
  else mv.3="FTNDOMAIN    1"
mv.4="DOMAINLIST  1"
mv.5="INDIR     1"
mv.6="OUTDIR    1"
mv.7="XFERQ     1"
mv.8="REXXDIR     1"
mv.9="REDIALDELAY   1"
mv.10="BUSYDELAY  1"
mv.11="IGNORENOANSWER   1"
mv.12="CALLWINDOWMIN  1"
mv.13="DOMAINAWARE    1"
mv.14="WSPEC    1"
mv.15="WPOS     0"
mv.16="SSPEC    0"
mv.17="SPOS     0"
mv.18="BOSS     0"
mv.19="LOGWINDOW  0"
mv.20="POLLWIN    1"
mv.21="XPRWIN     0"
mv.22="FLODIR     1"
mv.23="NODELIST   1"
numclips=23
if (u_shelter="ROOF" | u_shelter="PORTICUS") then do
mv.24="MENUS    1"
mv.25="SYSOPBASE  1"
mv.26="FREQDIR    0"
numclips=26
end

do i=1 to numclips
  if ~SetClip(upper(word(mv.i,1)),ReadVar(word(mv.i,1))) then do
    if strip(word(mv.i,2))=0 then say "Warning: Variable "word(mv.i,1)" is not set"
    else do
      say "Error: Variable "word(mv.i,1)" is not set ENV:"envpath GetVar(envpath||word(mv.i,1),"G")
      exit 10
    end
  end
end
call SetClip('DOMAIN',GetClip('FTNDOMAIN'))
address COMMAND 'Assign NODELIST:' GetClip('NODELIST')
liblist.1="rexxsupport.library"
liblist.2="OwnDevUnit.library"
liblist.3="XferQ.library"
liblist.4="xprzedzap.library"
liblist.5="xprfts.library"
liblist.6="wpl.library"
liblist.7="xpremsi.library"
liblist.8="rexxdossupport.library"
reqdlibs=8
say "Checking for required libraries"
do i=1 to reqdlibs
  parse var liblist.i libname level .
  if ~exists('LIBS:'||libname) then do
    say 'Missing required library LIBS:'libname', please investigate'
    exit 20
  end
end
/* Directories to create*/
dir.1=GetClip('INDIR')
dir.2=GetClip('OUTDIR')
dir.3=GetClip('FREQDIR')
dir.4=GetClip('FLODIR')
dir.5=GetClip('INDIR')||"/NONSECURE"
dir.6=GetClip('INDIR')||"/RESUME"
dir.7=GetClip('INDIR')||"/FTNSORT"
dir.8=GetClip('XFERQ')
dirs=8
if u_shelter="ROOF" | u_shelter="PORTICUS" then do
dir.9=GetClip('INDIR')||"/USERS"
dir.10="LOG:rfsacct"
dir.11="LOG:rfsacct/h"
dir.12="LOG:/FREQIT"
dir.13="CFG:/FREQIT"
dirs=13
end
say "Checking for required directories"
do i=1 to dirs
  call makedir(dir.i)
end

address COMMAND 'Assign XFERQ:' GetClip('XFERQ')
domain=GetClip('DOMAIN')
HERE=GetClip('HOST.ADDRESS.'domain)
Address COMMAND "Echo >XFERQ:hostaddr" domain"#"HERE
singleinbound=GetClip('DOMAINAWARE')=="TRUE"
dl=GetClip('DOMAINLIST')
indir=GetClip('INDIR')
outdir=GetClip('OUTDIR')
do ftn=1 to words(dl)-1 by 2
  if ~singleinbound then do
    call makedir(indir||'/'||word(dl,ftn))
    call makedir(outdir||'/'||word(dl,ftn))
  end
  vname="HOST.ADDRESS."||upper(word(dl,ftn))
  if ~SetClip(vname,ReadVar(vname)) then do
    say "Error: Variable "vname" is not set"
    exit 10
  end
end
if u_shelter="PORTICUS" then Address REXX GetClip('REXXDIR')"/PRODCFG DO"
return

ReadVar: procedure expose ENVPATH
  if arg(2)="R" then x=GetVar(arg(1),"G")
  else x=GetVar(envpath||arg(1),"G")
return x

lower:
return(bitor(arg(1),'20'x))

PutLog:  procedure expose fgroup u_shelter slave log havewin
if havewin=1 then say arg(1)
if slave="SLAVE" then slave="MGR"
if log=1 then address 'ROOFLOG' 'logline' left(time(),5) 'SMM: 'arg(1)
address 'LOGPROC' 'PutLog 'fgroup time() u_shelter||slave': 'arg(1)
return 0

w_height: procedure expose fontsize
BAR=13 /* TOP BORDER + BOTTOM BORDER */
if fontsize="" then fontheight=8
  else fontheight=fontsize
return ((arg(1)*fontheight)+BAR)

w_width: procedure expose fontsize
BORDER=10 /* LEFT BORDER + RIGHT BORDER */
if fontsize="" then fontwidth=8
   else fontwidth=fontsize
return ((arg(1)*fontwidth)+BORDER)

addslash:
curr=arg(1)
select
when right(curr, 1)=":" then nop
when right(curr, 1)="/" then nop  /* TackOn */
otherwise curr=curr"/"
end
return curr
/* a useful procedure by Walt Sullivan	*/
dequote: procedure
parse arg thing
parse var thing '"' unq_thing '"'
if unq_thing ~="" then return unq_thing
return thing


break_c:
break_d:
call callcleanup()
PutLog('User Aborted 'what where)
exit 0
novalue:  call template_oops "Novalue" sigl
syntax:   call template_oops "Syntax(RC=" || RC || ")" sigl RC
failure:  call template_oops "Failure(RC=" || RC || ")" sigl
ioerr:    call template_oops "IOErr(RC=" || RC || ")" sigl
halt:     call template_oops "Halt" sigl
template_oops:
parse arg what badline code
if code~="" then call PutLog("ERROR LINE:"badline errortext(code))
  else call PutLog("ERROR LINE:"badline what)
cleanup:
call XfqClose()
exit(40)

/**/
usage:
say CLS
if shelter="" then do
  Say "No Shelter Mailer available"
  u_shelter="*** NO SHELTER ***"
end
say BOLD||u_shelter" Mailer Manager"||OFF" v"smver
say ITALICS"   Usage: Shelter <command> <options>"OFF
say BOLD"     START"OFF"      - load mailer"
say BOLD"     EXIT"OFF"       - unload mailer"
say BOLD"     RESTART"OFF"    - unload, compile and reload mailer"
if u_shelter="UMBRELLA" then say BOLD"     AUTO"OFF"       - load,convert,call Boss and exit"
else say BOLD"     AUTO"OFF"       - load, convert and call Hub"
say
say BOLD"     ADDWORK"OFF" site fullfilename (disposition) (priority)"
say "               - add a file to a site queue"
SAY "               disposition:"
SAY "               D=delete, T=truncate, L=do nothing (default)"
SAY "               priority: (-128 to +128)    (default CRASH)"
SAY "               or HOLD=-50, NORM=0, DIRECT=30, CRASH=50"
say BOLD"     FLOCVT"OFF"     - convert 4d ?LO/?UT files to XferQ"
say BOLD"     CLEAN"OFF"      - remove non-existing files from queue"
say
callusage:
if u_shelter~="UMBRELLA" then do
say BOLD"     CALL"OFF" site (CRASH|NOPICKUP|phonenumber|line) (line)"
say "               - start a site poll"
say "               site=[domain#][z:][net/]node[.p]"
say "               site=uu(sitename) | clock(n) | bbs/fax_(sitename)"
say BOLD"     KILL"OFF" site    - abort a site poll"
say BOLD"     POLL"OFF" (priority) - poll all non-HOLD sites with pending mail"
say "               priority = NORMAL, DIRECT, CRASH" 
end;else do
say BOLD"     CALL"OFF" site (number)"
say "               - start a site poll"
say BOLD"     KILL"OFF" site"
say "               - abort a site poll"
say "               site=[domain#][z:][net/]node[.p]"
end
exit 0
/**/

openpscr:
  pscreen=ReadVar('SCREEN')
  scfg='CFG:WPL/GEN/'shelter'/SCREEN.CFG'
  if upper(pscreen)="WORKBENCH SCREEN" then return
  Interpret include(scfg)
  if SCREENPREFS="" | SCREENPREFS="SCREENPREFS" then do
    Say "Error reading "scfg
    exit 20
  end
  parse var SCREENPREFS width','height','planes
  colors=2**planes
  parse var SCREENFONT font','fontsize
  modes=translate(SCREENMODES," ",",")
  globals=translate(SCREENGLOBALS," ",",")
  if pos('AUTOCLOSE',globals)>0 & pos('WAIT',GetClip(sspec))=0 then do
    Say "Error: cannot open a non-WAIT window on an AUTOCLOSE screen"
    exit 20
  end;else do
    call SetClip("SSMAUTOCLOSE","TRUE")
  end
  cxx=translate(SCREENCX,' "',",'")
  if index(modes,"L") ~=0 then textoverscan_height=TEXTOVERSCAN_HEIGHT*2
  rgball=""
  do i=0 to colors-1
    if RGB.i="" then leave
    rgball=rgball||d2x(word(RGB.i,1))||d2x(word(RGB.i,2))||d2x(word(RGB.i,3))||','
  end
  rgball=delstr(rgball,lastpos(',',rgball),1)
  if width>640 then t_width=width-TEXTOVERSCAN_WIDTH
    else t_width=0
  if height>230 then t_height=height-TEXTOVERSCAN_HEIGHT
    else t_height=0
  if t_width~=0 | t_height~=0 then do
    if pos('-',t_width)=0 then t_width='+'||t_width
    if pos('-',t_height)=0 then t_height='+'||t_height
    sz='SIZE=OSCAN_TXT:0,0,'t_width','t_height' DISPCLIP=OSCAN_TEXT'
  end
  else sz='SIZE='width','height
  if SCREENPEN="" | SCREENPENS="SCREENPENS" then opts=sz' PLANES='planes 'COLORS='rgball 'MODE='modes 'FONT='font'.'fontsize globals cxx
    else opts=sz' PLANES='planes 'PENS='SCREENPENS 'COLORS='rgball 'MODE='modes 'FONT='font'.'fontsize globals cxx
  cmd='ScreenManager OPEN "'pscreen'"' opts
  Say 'Executing:'cmd
  address COMMAND cmd
  if RC~=0 then say "Could not open screen:" pscreen
  else call setclip('SMMPSCREEN','TRUE')
return

closepscr:
  if GetClip('SMMAUTOCLOSE')="TRUE" then return
  pscreen=GetClip('SCREEN')
  if upper(pscreen)="WORKBENCH SCREEN" then return
  myscreen=GetClip('SMMPSCREEN')
  if upper(myscreen)~="TRUE" then return
  call SetClip('SMMPSCREEN',"")
  call close('STDIN')
  call close('STDOUT')
  call delay(50)
  address COMMAND 'ScreenManager >NIL: CLOSE "'pscreen'"'
return

setup:
shelter=arg(1)
u_shelter=upper(shelter)
l_shelter=lower(shelter)
call SetClip('SHELTER',u_shelter)
if u_shelter="ROOF" then envpath=""
else envpath=shelter"/"

callscript="S:"||left(u_shelter,1)||"CALL"
file=l_shelter'file'
fwindow=l_shelter'win'
fgroup=l_shelter'wpl'
window=l_shelter'ss'
wgroup=l_shelter'wplstat'
mport=u_shelter
if (u_shelter="UMBRELLA" | u_shelter="GAZEBO") then do
  wsrc.1=l_shelter'CFG.wpl'
  wsrc.2=l_shelter'MODEM.wpl'
  wsrc.3=l_shelter'.wpl'
  wscount=3
end;else do
  if ReadVar('MENUS')="FILE" then do
    wsrc.1=l_shelter'CFG.wpl'
    wsrc.2=l_shelter'MODEM.wpl'
    wsrc.3=l_shelter'NOTIFY.wpl'
    wsrc.4=l_shelter'USERS.wpl'
    wsrc.5=l_shelter'.wpl'
    wscount=5
  end;else do
    wsrc.1=l_shelter'CFG.wpl'
    wsrc.2=l_shelter'MENUS.wpl'
    wsrc.3=l_shelter'MODEM.wpl'
    wsrc.4=l_shelter'USERS.wpl'
    wsrc.5=l_shelter'NOTIFY.wpl'
    wsrc.6=l_shelter'.wpl'
    wscount=6
  end
end
return

openwin:
wpos=GetClip('WPOS')
if wpos="" | wpos="WPOS" then wpos="0/80/600/40"
wspec=GetClip('WSPEC')
if wspec="" | wspec="WSPEC" then wspec="INACTIVE/AUTO/WAIT"
spos=GetClip('SPOS')
if spos="" | spos="SPOS" then spos="0/80/600/80"
sspec=GetClip('SSPEC')
if sspec="" | sspec="SSPEC" then sspec="INACTIVE/AUTO/WAIT"
if arg(1)="P" then win='CON:'spos'/'u_shelter' Mailer Manager v'smver' [Click to Close]/'sspec'/SCREEN'
else if arg(1)="S" then do
  x=pos('/WAIT',wspec)
  if x~=0 then wspec=delstr(wspec,x,5)
  win='CON:'wpos'/'u_shelter' Mailer Manager v'smver'/'wspec'/SCREEN'
end
pscreen=ReadVar('SCREEN')
call close('STDOUT');call open('STDOUT',win||pscreen,'W');call close('STDIN');call open('STDIN','*','R')
havewin=1
return

isftn:
if datatype(arg1,"N") then return 1
if pos(arg(1),"#")>0 | pos(arg(1),":")>0 | pos(arg(1),"/")>0 then return 1
return 0