/**/
v="$VER: Call Rexx    WPL Call Management                Williamson 54.35"
reqck=1
options results
options failat 150
signal on syntax  
signal on halt
signal on break_c
signal on break_d
sv="v"||right(v,5)
script='Call'
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", 0, -30, 2) then do
    say "Couldn't access rexxdossupport.library !"
    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

lookup=GetClip('LOOKUP')||" >NIL: "
nlentry="nl"||Pragma('ID')
dl=GetClip('DOMAINLIST')
def_domain=GetClip('DOMAIN')
calltask=x2d(Pragma('ID'))
callstart=time('n')
log=show("P","ROOFLOG")
squote="'"
docall=1;nocall=0;callcount=0
/*d_stat, make_call returns*/
callok=0;resched=1;retry=5;exitcall=10

def_line=GetClip('DEFAULT_SLAVE')
busydelay=GetClip('BUSYDELAY')
/* get our directories */
rpath=addslash(dequote(GetClip('REXXDIR')))
outdir=addslash(dequote(GetClip('OUTDIR')))
indir=addslash(dequote(GetClip('INDIR')))
freqdir=addslash(dequote(GetClip('FREQDIR')))
call close('STDIN')
call open('STDIN','*','R')

 parse arg args
 number="";port="";line="";hand="";pro="";pri="";redialdelay="";duration=""
 force=0;ifstuff=0;crash=0;nopickup=0;manual=0;debug=0
 doscan=GetClip('DOSCAN')                /* enables wpl_port status scan */
 dolookup=GetClip('DOLOOKUP')            /* check nodelist for CM flag   */
  
 template="Site_Address/A,PORT/K,LINE/K,NUMBER/K,HAND/K,PRO/K,PRI/K,REDIALDELAY/K,DURATION/K,IFSTUFF/S,CRASH/S,FORCE/S,NOPICKUP/S,DOSCAN/S,DOLOOKUP/S,DEBUG/S"
 if ~ReadArgs(args,template) then do
  say Fault(RC,script)
  signal usage
 end;else do
  if site_address="?" then signal usage
  if pri~="" then call Pragma('p',pri)
  else call Pragma('p',-1)
  if number~="" then do
    man_number=number
    manual=1
  end 
  if port~="" then wplbase=port
  else wplbase="ROOF"
  if line~="" then do
    requested_line=line
  end;else do
    requested_line=def_line
  end
  if redialdelay="" then redialdelay=GetClip('REDIALDELAY')
  if duration="" then duration=GetClip('CALLWINDOWMIN')
  houtflags=""
  if hand~="" then do
    htype.4="FAST" ;hoflag.4="DE,"
    htype.3="EMSI" ;hoflag.3="GE,"
    htype.2="WAZOO";hoflag.2="G6,D6,"
    htype.1="FTS1" ;hoflag.1="G1,D1,"
    htypes=4
    do h=1 to htypes
      if pos(htype.h,upper(hand))>0 then houtflags=houtflags||hoflag.h
    end
    houtflags=strip(houtflags,'T',',')
  end
  if pro~="" then do
    wzc=0;wzp="";wzps="";pro=upper(pro)  
    npro=translate(pro," ",",")
    sport=wplbase||requested_line
    Address VALUE sport
    'String $(emsi.compat.'requested_line')';apro=RESULT
    do i=1 to words(npro)
      if pos(word(npro,i),apro)=0 then do
        call PutLog('Protocol 'word(npro,i)' not available ['apro'] on line 'requested_line,30,60)
        exit 20
      end
      if word(npro,i)="SLK" then do
        wzc=wzc+1;wzp=wzp'$(xp.1) ';wzps=wzps'DietIFNA(SLK) '
      end;else if word(npro,i)="ZMO" then do
        wzc=wzc+4;wzp=wzp'$(xp.4) ';wzps=wzps'ZedZip(ZMO) ' 
      end;else if word(npro,i)="ZAP" then do
        wzc=wzc+8;wzp=wzp'$(xp.8) ';wzps=wzps'ZedZap(ZAP) '
      end;else if word(npro,i)="HYD" then do
        wzc=wzc+32;wzp=wzp'$(xp.32) ';wzps=wzps'Hydra(HYD) '
      end
    end
    wzp=strip(wzp);wzps=strip(wzps)
    drop npro apro
  end
  bbs=0;fax=0;clock=0;uucp=0;ftn=0
  bbs  =left(upper(site_address),3)=="BBS"
  fax  =left(upper(site_address),3)=="FAX"
  clock  =(~fax & ~bbs & left(upper(site_address),5)="CLOCK")
  uucp   =(~fax & ~bbs &~clock) & (left(upper(site_address),2)=="UU" | datatype(right(site_address,2),'MIXED'))
  ftn  =(~bbs & ~fax & ~uucp & ~clock)
  if bbs | fax | clock then site_address=upper(site_address)
    else if uucp then site_address=delstr(site_address,1,2)
        else site_address=make5d(site_address)
  if site_address=0 then do
    call PutLog('BAD site_address',10,10)
    exit 10
  end
end
  /* check if there is already a dial session for this address  */
  cs=strip(GetClip(site_address))
  if datatype(cs)='NUM' & ~force then do
    call PutLog('Already calling 'site_address' Status:['cs']',30,60)
    call cleanup
    exit 10     
  end
  fr_checked=0;fr_logged=0
  line=requested_line
  sport=wplbase||line
  if ftn & ifstuff then do
    stuff=0
    if find_ifreq(site_address) then stuff=1
    
    site=XfqGetAddress(site_address)
    sx=XfqAnyWork(site)
    if sx ~= 2 then stuff=1
    call XfqDropObject(site)
    call XfqClose()
    if ~stuff then do
      call PutLog('No work for 'site_address,10,60)
      call cleanup
      exit
    end
  end


  /* Check Nodelist */
  if ftn & ~manual & dolookup then do
    cmd=lookup site_address 'nodelist:' nlentry
    address COMMAND cmd
    if ReadVar(nlentry'.number') ~= "" then do
      if index(ReadVar(nlentry'.Flags'),'CM')=0 then do
        call PutLog(site_address 'not CM, scheduling for UMH',10,60)
        site_address="'"site_address"'"||' UMH'
        if wplbase="ROOF" then address "FLOWMGR" "RESCHED" site_address
        call cleanup
        exit 0
      end
    end;else do
      call PutLog(site_address 'not in Nodelist',10,60)
      if ~manual then do
        call cleanup  
        exit 0  
      end
    end
  end
  if bbs | fax then  call PutLog('Polling 'site_address' on line' line,40,60)
  else if clock then call PutLog('Polling 'site_address' on line' line,40,60)
  else if uucp then call PutLog('Polling UUCP Site 'site_address' on line' line,40,60)
  else call PutLog('Polling 'dd'#'z':'n'/'f'.'p 'on line' line,40,60)

  if manual then call PutLog('Manual Poll 'man_number,30,60)
  if ftn & ~fr_checked then call find_ifreq(site_address)

  /* set the window for this address  */
  dial_from=time('s')
  df     =left(callstart,5)
  dial_till=dial_from + (duration*60)
  dt     =dial_till%(60*60)':'right('0'strip(left(dial_till//(60*60)/60,2),T,'.') ,2)

  callcount  =0
  call PutLog(dial_from dial_till duration df dt callcount,70,70)
  call PutLog('Line 'line site_address' Window: 'df'->'dt,60,60)  

/*  do while ( (time('s') < dial_till) | eof('STDOUT') )  */
  do while ( (time('s') < dial_till) )
    line=requested_line
    callcount=callcount+1
    p_stat=GetClip(site_address)    /* get call status, save local copy */
    call SetClip(site_address,callcount)  /* update status  */

    if p_stat='abort' then do  /* check for user abort  */
      call PutLog('User aborted poll to 'site_address' at 'left(time(),5)' on call 'callcount,30,60)
      call PutStatus('User abort')
      call SetClip(site_address,'USERABORT')
      call cleanup
      return(exitcall)
    end

    d_stat=do_dial()

    if d_stat=exitcall then do
      /*  DO NOT PUTSTATUS, we want the reason */
      call PutLog('Poll of 'site_address' terminated',60,60)
      call cleanup
      return 0
    end
    if d_stat=callok then do
      call PutLog('Poll of 'site_address' completed, Dur:'calldur,60,60)
      call PutStatus('Completed')  
      if ftn & fr_logged then call ck_freqstat
      call cleanup
      return 0
    end
  end     /*while within window*/

  /* we have spent too much time dialing this number  */
  call PutLog('Exceeded 'duration' min. call window for 'site_address', callcount:'callcount,10,60)
  call PutStatus('No Connect')
  call SetClip(site_address,'TIMEOUT'callcount)
  if ftn & wplbase="ROOF" then address "FLOWMGR" "RESCHED" "'"site_address"'"

  call PutLog('Poll of 'site_address' terminated on 'callcount,60,60)
  call cleanup 
exit 0

 do_dial:
  if ~show('p',wplbase||line) then do
    Call PutStatus('No 'wplbase||line,10,10)    
    call redial_pause(busydelay) 
    return(retry)
  end
  lines=GetClip('SLAVES')-1
  if line > lines then do
    call Putlog('Requested line 'line' is not active,using 'GetClip('DEFAULT_SLAVE') site_address,10,60)
    line=GetClip('DEFAULT_SLAVE')
  end
  if doscan then call scan_slaves

  /* What is the stat of THIS line */
  sport=wplbase||line
  Address VALUE sport
  'string $(state)';ws=RESULT
  Address
  if debug then call Putlog(sport' State:'ws,60,60)
  wstat=upper(word(ws,1))
  select
    when wstat='EXITING' then do
      call PutLog(sport' is exiting, aborting dial 'site_address,10,60)
      call PutStatus(sport 'exiting')
      return(exitcall)
    end
    when wstat='SESSION' then do
      if find(upper(ws),upper(site_address)) ~= 0 then do
        if force then call try_alternate
        else do
          call PutLog('Aborting call, already 'wstat site_address,40,60)
          call PutStatus('Aborting:'wstat)
          return(exitcall)
        end
      end
      else if upper(word(ws,2))="LOGIN" then call try_alternate
      else do
        call PutLog('Queuing dial of 'site_address,60,60) 
        call PutStatus('Queueing')  
      end
    end
    when wstat='DIALING' then do
      if find(upper(ws),upper(site_address)) ~= 0 then do
        if force then call try_alternate
        else do
          call PutLog('Aborting call, already 'wstat site_address,40,60)
          call PutStatus('Aborting:'wstat)
          return(exitcall)
        end
      end
      call try_alternate
    end
    when wstat='BUSY' then call try_alternate
    otherwise nop
  end
  sport=wplbase||line
  call PutLog('Line:' sport 'Dialing 'site_address,60,60)
  call PutStatus('Dialing')
  Address VALUE sport
  if manual then 'Set number' man_number 'manual TRUE'
  if ftn then do
    if crash then 'Set crash TRUE'
    if nopickup then 'Set nopickup TRUE'
    if houtflags~="" then do
      /* Get previous for later resoration */
      'String $(OutFlags.$(si.'site_address'))'
      oldflags=RESULT
      'Set OutFlags.$(si.'site_address')' houtflags
      call PutLog('Handshake changed from:'oldflags' to:'houtflags' for 'site_address,10,10)
    end
    if pro~="" then do
      'Set host.wzcap 'wzc' host.wzprot "'wzp'" host.compat "'upper(pro)'"'
      call PutLog('Protocols set WaZoo['wzc wzps'] Emsi['upper(pro)'] for 'site_address,10,10)
    end
  end
  'Set calltask.'site_address calltask 'callcount.'site_address callcount 'callstart.'site_address callstart
  'Call 'site_address  
  welstat=RC
  'String $(calldur.$(remote.address))'
  calldur=RESULT
  if houtflags~="" then do
    'Set OutFlags.$(si.'site_address')' oldflags
    call PutLog('Handshake reset from:'houtflags' to:'oldflags' for 'site_address,10,10)
  end
  Address
  call PutLog('RC 'welstat' on dial 'callcount site_address,60,60)
  /*
   ; $(dialrc) values used in ReplyCall:
   ; 0 - ok
   ; 1 - owndevunit
   ; 5 - busy
   ; 6 - no number
   ; 7 - call forwarded
   ; 10 - no modem
   ; 11 - carrier lost
   ; 12 - Modem response timeout
   ; 15 - badline
   ; 99 - bad handshake
  */
  select
    when welstat=0 then do
      call PutLog(site_address' OK on 'callcount,10,60)
      call SetClip(site_address,'OK')
      iF wplbase="ROOF" then address "FLOWMGR" "UNSCHED" "'"site_address"'"
      return(callok)
    end
    /* ctl-f on dial */
    when welstat=1 then do
      call PutLog(site_address' OWNDEVUNIT HAS LINE on 'callcount,10,60)
      call PutStatus('OWNDEVUNIT')
      return(retry)
    end

    when welstat=5 then do
      call PutLog(site_address' BUSY on 'callcount,70,50)   
      call PutStatus('BUSY')
      call redial_pause(redialdelay)
      return(retry)
    end

    when welstat=6 then do
      call PutLog(site_address' NO NUMBER TO CALL on 'callcount,70,50)
      call PutStatus('NO NUMBER')   
      return(exitcall)
    end
  
    when welstat=7 then do
      call PutLog('Call to 'site_address' forwarded',70,50)   
      call PutStatus('FORWARDED')
      return(exitcall)
    end

    when welstat=10 then do
      call PutLog(site_address' NO MODEM FOUND on 'callcount,10,60)
      call PutStatus('NO MODEM')
      return(exitcall)
    end
    when welstat=11 then do
      call PutLog(site_address' NO CARRIER on 'callcount,10,60)
      call PutStatus('NO CARRIER')
      call redial_pause(redialdelay)
      return(retry)
    end
    when welstat=12 then do
      call PutLog(site_address' MODEM RESPONSE TIMEOUT on 'callcount,10,60)
      call PutStatus('NO MODEM')  
      call redial_pause(redialdelay)
      return(retry)
    end

    when welstat=15 then do
      call PutStatus('BADLINE')
      if GetClip('IGNORENOANSWER')='FALSE' then do
        call PutLog(site_address' EXIT_BADLINE on 'callcount,10,60)
        return(exitcall)
      end;else do
        call PutLog(site_address' EXIT_BADLINE on 'callcount,70,50)
        call redial_pause(redialdelay)  
        return(retry) 
      end
    end
    when welstat=99 then do
      call PutStatus('NOHANDSHAKE')
      call PutLog(site_address' EXIT_BADHANDSHAKE on 'callcount,10,60)
      return(exitcall)
    end
    otherwise do
      call PutLog('Call 'callcount' to 'site_address' Status: 'welstat,10,60)
      call PutStatus('Unknown:'welstat)
      return(exitcall)
    end
  end /*select*/
  PutLog('Fall through! Call 'callcount' to 'site_address' Status: 'welstat,10,60)
 return(retry)

 redial_pause:
  call PutLog('Waiting 'arg(1)' Secs Call:'site_address,60,60)
  call delay(arg(1)*50)
 return 0

try_alternate:
  alt_line=GetClip('ALTERNATE_SLAVE')
  if alt_line="" | alt_line=requested_line then Call PutLog('Line 'line' Busy' site_address,60,60) 
  else do
    line=alt_line
    PutLog('Using alternate: 'wplbase||line site_address,10,60)
  end
return

 find_ifreq:   /* check if any file requests for this node  */
  fr_checked=1
  fr_logged=0
  call PutLog('Checking for outbound Freqs for 'n'/'f,60,60)

  reqspec4d=outdir||z'.'n'.'f'.'p'.REQ'
  reqspec2d=outdir||right(d2x(n),4,"0")||right(d2x(f),4,"0")'.REQ'

  if exists(reqspec4d) | exists(reqspec2d) then do
    if ~open('rs',reqspec4d,'r') then do
      call open('rs',reqspec2d,'r')
      reqspec=reqspec2d
    end;else reqspec=reqspec4d

    call PutLog('Freq 'reqspec' for 'site_address,60,60)
    if reqck then do
      reqckF=outdir||z'.'n'.'f'.'p'.REQCK'
      if exists(reqckF) then do
        call PutLog('FreqTracker 'reqckF' exists',10,10)
        reqckO=0
      end;else do
        call PutLog('Creating FreqTracker 'reqckF' for 'site_address,40,60)
        call open('rck',reqckF,'w')
        reqckO=1
      end
    end
    do while ~eof('rs')
      rfn=strip(readln('rs'),'b','0d'x)
      if rfn ~= "" then call PutLog('Requesting ['rfn'] from 'site_address,10,60)
      if reqck & reqckO then do
        x=pos(';',rfn) 
        if x>0 then rfn=delstr(rfn,x,1)
        call writeln('rck',rfn)
      end
    end
    call close('rs')
    fr_logged=1
    if reqck & reqckO then call close('rck')
    else address COMMAND 'Copy >nil: 'reqspec reqspec'TEMP'
    address COMMAND 'Copy >nil: 'reqspec reqspec'HYD'
    return(docall)
  end;else do
    call PutLog('Found No File Requests for 'site_address,60,60)
  end
return(docall)

 ck_freqstat:
  if exists(reqspec) then do
    call PutLog(reqspec' was not sent to 'site_address,10,60)
    if reqck & reqckO then call delete(reqckF)
    if ~reqck then call delete(reqspec'TEMP')
    call delete (reqspec'HYD')
    return(exitcall)
  end
return(0)

 scan_slaves:
  do i=1 to lines
    xport=wplbase||i
    if ~show('p',xport) then iterate
    Address VALUE xport
    'string $(state)';xws=RESULT
    Address
    call Putlog('Line:' xport 'State:'xws,60,60)
    xwstat=upper(word(xws,1))
    if xwstat='SESSION' | xwstat='DIALING' then do
      if find(upper(xws),site_address) ~= 0 then do
        call PutLog('Aborting call 'xwstat site_address' on line 'i,60,60)
        return(exitcall)
      end
    end
  end
return


make5d: procedure expose dl def_domain 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=def_domain
  cfgaddress=GetClip('HOST.ADDRESS.'myaddress.domain)
  parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point
  myaddress.pointnet =GetClip('POINTNET')

  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
    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']',50,60)
    return 0
  end
  drop da
return(dd'#'z':'n'/'f'.'p)

ReadVar:
  if ~open('v','ENV:'arg(1),'r') then return ""
  x=readln('v')
  call close('v')
return x

 addslash:
  curr=arg(1)
  select
    when right(curr, 1)=":" then nop
    when right(curr, 1)="/" then nop
      otherwise curr=curr"/"
  end
return(curr)

 /* a useful procedure by Walt Sullivan	*/
dequote:
 parse arg thing
 parse var thing '"' unq_thing '"'
 if unq_thing ~= "" then return unq_thing
return thing

PutStatus:
  if calldur="" | calldur='CALLDUR' then calldur="??:??:??"
  if log then Address "ROOFLOG" 'CALLSTATUS' calltask line callcount callstart time() calldur site_address arg(1)
return RC

PutLog:  procedure expose script log
 if arg(2) > GetClip('LOGLEVEL') then return 0
 if log then address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
return 0

 /*  Error handling */

 cleanup:
  call PutLog('Removing 'site_address' from dial queue',60,60)
  call SetClip(site_address)
  address COMMAND "Delete >NIL: ENV:"nlentry".#?"
 return 0

 break_c:
 break_d:
  call PutLog('User aborted poll of 'site_address' on 'callcount,10,60)
  call cleanup
  exit 10

/* Miscellaneous utility functions */

/* handle references to uninitialized variables by saying which line */
/* and typing the offending line.                   */
novalue: call template_oops "Novalue" sigl
failure: call template_oops "Failure(RC=" || RC || ")" sigl
halt:  call template_oops "Halt" sigl 
syntax:  
if RC=13 then do
  call PutLog("Function Host not active",20,20)
  call template_oops "Syntax(RC=" || RC || ")" sigl RC
end
template_oops: 
parse arg what badline code
if code ~="" then call PutLog("ERR: Line "badline what errortext(code),10,60)
else call PutLog("ERR: Line" badline what,10,60)
call PutStatus('Error Exit')
call cleanup
exit(40)
usage:
say template
say "       Site_Address    FTN-  [domain#][z:][net/]node[.p] CLOCK- clock<n>"
say "                       UUCP- uu<site> FAX- fax_<site> BBS- bbs_<site>"
say "       Number          phone number when manual dialing"
say "       Port            base name of mailer ports     DEFAULT ROOF"
say "       Line            modem line to use for dialing DEFAULT "def_line
say "       Hand            handshake command separated   DEFAULT "def_line
say "                       FTS,WAZOO,EMSI,FAST"
say "       Pri             task priority for poll        DEFAULT -1"
say "       RedialDelay     seconds to wait between dials DEFAULT "GetClip('REDIALDELAY')
say "       Duration        minutes to attempt connection DEFAULT "GetCLip('CALLWINDOWMIN')
say "   Switches            all DEFAULT to FALSE"
say "       ifstuff         call only if files pending"
say "       crash           send crash mail only"
say "       nopickup        do not accept inbound files"
say "       force           disables check for poll in progress"
say "                       and forces use of specified line"
say "       doscan          enables wpl port status scan "
say "       dolookup        call only if CM flag in nodelist"
say "       debug           verbose output"
say
exit 0
/**/