/*
             Rock v1.6 - Fidonet mailer for point systems

  This file is modified from jaz.f, Copyright (c) 1994 Robert Williamson
       Modifications for Rock are Copyright (C) 1995  Jean-Marc Xiume'
         This software is distributed under the terms of the
    GNU General Public License. Read "license.doc" for more details.

********************** Outbound scanner for XferQ **********************
*/

LF='A'x
CR='D'x

qout=1

options results
options failat 99

Parse upper arg od ha ra .

call random(,,time(s))

OBJ=XfqGetAddress(ra)
if XfqSessionUp(OBJ) then do
  if ~XfqHoldMailer(OBJ) then do
    drop XFQERRORCODE XFQERRORMSG
    call XfqDropObject(OBJ)
    call XfqClose()
    exit 0
  end
end
else do
  Say 'Site 'ra' not online, exiting rock.rexx'
  drop XFQERRORCODE XFQERRORMSG
  call XfqDropObject(OBJ)
  call XfqClose()
  return 1
end

id=pragma('ID')
xpr.H=0
xpr.C=50
xpr.D=30
xpr.N=0
xpr.F=0
xpr.O=0

parse var ra rd "#" rz ":" rn "/" rf "." rp .
call sflos()
call souts()

cleanup:
call XfqReleaseMailer(OBJ)
call XfqDropObject(OBJ)
call XfqClose()
call delete('T:f'id)
call delete('T:o'id)
exit 0


sFLOS:
Address COMMAND 'LIST >T:f'id od||rz'.'rn'.'rf'.'rp'.?LO quick nohead'
if word(statef("T:f"id),2)=0 then return 0
if ~open('fl',"T:f"id,'R') then return 0
i=0

do while ~eof('fl')
  L=Upper(strip(space(ReadLn('fl'),1),'B'))
  if L="" then iterate
  i=i+1
  ff.i=L
  parse var L fln.i.zone"."fln.i.net"."fln.i.node"."fln.i.point"."junk
  ft=left(junk,1)
  if pos(ft,'H C D N F')>0 then ff.i.pr=xpr.ft
  else Iterate
end

call close('fl')
if i=0 then return 0
ff.nn=i
do an=1 until an=ff.nn
  err=0
  fnm=upper(od||ff.an)
  if ~exists(fnm) then err=1
  else if ~Open('ff',fnm,'R') then err=1

  if ~err then do
    say 'Scanning 'fnm
    do while ~eof('ff')

      L=""
      C=readch('ff',1)
      do while (C~=CR & C~=LF & ~eof('ff'))
	L=L||C
	C=readch('ff',1)
      end
      if L="" then iterate
      L=upper(L)

      flg=20
      dp=left(L,1)
      if dp="#" then do
	flg=22
	L=delstr(L,1,1)
      end
      else if dp="^"|dp="-" then do
	flg=21
	L=delstr(L,1,1)
      end
      else if dp="@" then do
	flg=20
	L=delstr(L,1,1)
      end
      if pos(":",L)=0 then L=od||L
      if ~exists(L) then do
	say 'Cannot find 'L
	iterate
      end

      parse var L x '.' x '.' x '.' x '.' ex
      drop x
      if ex="" then do
	if right(L,3)="TIC" then flg=21
	as=gfn(L)
	p=ff.an.pr
      end
      else do
	tx=upper(left(ex,2))
	if datatype(right(ex,1),'n')&(tx="MO"|tx="TU"|tx="WE"|tx="TH"|tx="FR"|tx="SA"|tx="SU") then do
	  as=right(compress(time(),":"),4)||d2x(random(0,255)+256*random(0,255),4)||'.'ex
	  flg=21
	  p=ff.an.pr
	end
	else do
	  as=gfn(L)
	  flg=20
	  p=ff.an.pr
	end
      end
      drop ex

      QUERY.XQ_NAME=L
      QUERY.XQ_SITE=OBJ
      wn=NULL
      wn=XfqFindWork(QUERY)
      if wn=NULL then do
	say 'Sending:'L' ['as'] :'ra' Disp:'flg' Pri:'p
	call XfqAddWorkQuick(ra,L,as,p,flg)
      end
      else call XfqUnlockWork(wn)

    end
    call close('ff')
  end

  if wn~=NULL then call XfqDropObject(wn)
end
return 0


sOUTS:

Address COMMAND 'LIST >T:o'id od||rz'.'rn'.'rf'.'rp'.?UT quick nohead'
if word(statef("T:o"id),2)=0 then return 0
if ~open('o',"T:o"id,'R') then return 0

do while ~eof('o')
  of=upper(readln('o'))
  if of="" then iterate

  parse var of x '.' x '.' x '.' x '.' ex
  drop x
  if ~qout & ex="OUT" then Iterate

  xt=left(ex,1)
  if pos(xt,'H C D N O')>0 then p=xpr.xt
  else Iterate

  file=od||of
  /* as=left(date(),2)||compress(time(),":")||".PKT" */
  as=right(compress(time(),":"),4)||d2x(random(0,255)+256*random(0,255),4)||'.PKT'
  flg=21
  QUERY.XQ_NAME=file
  QUERY.XQ_SITE=OBJ
  wn=NULL
  wn=XfqFindWork(QUERY)
  if wn=NULL then do
    say 'Sending:'file' ['as'] :'ra' Disp:'flg' Pri:'p
    call XfqAddWorkQuick(ra,file,as,p,flg)
  end
  else call XfqUnlockWork(wn)
  if wn~=NULL then call XfqDropObject(wn)
end
call close('o')
return 0


gfn: 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)