/**/
v="$VER: RFS Rexx WPL Mailer File Request Server  Williamson 55.03"
Parse Arg wplport Line baud host_address Infile Listed remote_address remote_sysop
if arg()=0 then EXIT
script="RFS"
xfq_site_object=XfqGetAddress(remote_address)
if ~XfqHoldMailer(xfq_site_object) then do
    address "LOGPROC" 'Putlog 'loggroup time() Line script 'HOLD Failed:'XFQERRORMSG remote_address
    drop XFQERRORCODE XFQERRORMSG
end
TRUE=1;FALSE=0
verbose=FALSE;debug=FALSE /*if debug TRUE, files not queued, req not deleted*/
Options failat 99
Options Results
numeric digits 14
Signal On Syntax
Signal On IOErr
sv="v"right(v,5)
if upper(wplport)="DEBUG" then do
    Parse Arg junk wplport Line Baud host_address Infile Listed remote_address remote_sysop
    verbose=TRUE;debug=TRUE;loggroup='RFS'
    address "LOGPROC" 
    'OpenLog RFS w RAW:0/0/600/200/RFS'
    'AddLogGroup RFS RFS'
    'Putlog 'loggroup time() Line script 'Debug Enabled'
    address
end

cr='0D'x;lf="0A"x;quote='"'
LogBuf="";AccBuf="";MsgBuf=""
if debug then loggroup="RFS"
else loggroup=lower(wplport)"wpl"
call setconfig

if Priority~=0 then oldpri=Pragma('Priority',Priority)
parse var remote_address hisaddress.domain '#' hisaddress.zone ':' hisaddress.net '/' hisaddress.node '.' hisaddress.point
remote_sysop=strip(remote_sysop)
if remote_sysop="" then remote_sysop="Unknown Sysop"
address "LOGPROC" 'Putlog 'loggroup time() Line script sv 'Serving 'remote_sysop' of 'remote_address' on 'upper(wplport)line
LogBuf=LogBuf||date() time()' RFS Serving 'remote_sysop' of 'remote_address' on 'upper(wplport)||line||lf

XQ_DELETE=1     /* Delete file after sending             */
XQ_IMMEDIATE=4  /* Send only if session currently up     */
DTPRI_CRASH=50

tlist="T:rfs_t"Line;ulist="T:rfs_u"Line
a=0;b=0;i=0;x=0;Sent=0;TBytes=0

parse var host_address myaddress.domain '#' myaddress.zone ':' myaddress.net '/' myaddress.node '.' myaddress.point

if pos("GRAB",InFile)=0 then Human=FALSE
else do
    Human=TRUE
    AcctPath=AcctPath"H/"    
    if ~listed then MaxBytes=MaxHBytes
    else do
        MaxHDaily=MaxHDaily*10 
        MaxBytes=baud*100
    end
end

/* exclusion processing */
if debug then address "LOGPROC" 'Putlog 'loggroup time() Line "Exclusion processing"
if ~ReqHuman & Human then do
    address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Humans excluded!"
    LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Humans excluded'lf
    call writepkt('File request terminated: Humans are excluded at this time.'cr)
    Signal GoodBye
end
if ~ReqPoint & (hisaddress.point > "0") then do
    address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Points Not Supported!"
    LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Points Not Allowed'lf
    call writepkt('File request terminated: Points are not currently served.'cr)
    Signal GoodBye
end

if ~ReqUnlisted & ~Listed & ~Human then do
    address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Unlisted Systems Not Supported!"
    LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Unlisted System'lf
    call writepkt('File request terminated: Unlisted System ('remote_address')'cr)
    Signal GoodBye
end

if EXCLUDE.0~=0 then
do zz=1 to EXCLUDE.0
    if upper(remote_address)=upper(Exclude.zz) then do
        address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Excluded Node!"
        LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Excluded Node!'lf
        call writepkt('File request terminated: Your system is not authorized to request files here.'cr)
        Signal GoodBye
    end
end

/* Read Accounting Data */
AcctFile=AcctPath||translate(remote_address,'...','#:/')
if exists(AcctFile) then do
    if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Reading Accounting Information"
    call open('Acct',AcctFile,'R')
    FirstDate=readln('Acct')
    LastDate=readln('Acct')
    NumReqs =readln('Acct')
    ReqFiles=readln('Acct')
    ReqBytes=readln('Acct')
    LastBytes=readln('Acct')
    UserCalls=readln('Acct')
    call close('Acct')
    if LastDate=Date() then UserCalls=UserCalls+1
    else do
        LastBytes=0
        UserCalls=0
    end
    FirstCall=""
end;else do
    FirstDate=Date();LastDate=Date()
    NumReqs=0;ReqFiles=0;ReqBytes=0;LastBytes=0;UserCalls=0
end

if Human & (UserCalls > MaxCalls) then do
    address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Human exceeded max calls!"
    if human then call send(' Refusing Request! Human exceeded max calls!\r\n') 
    LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Humans exceeded max calls'lf
    call writepkt('File request terminated: Exceeded Maximum sessions per day.'cr)
    Signal GoodBye
end

if Human & (MaxHTotal~=0 & (ReqBytes > MaxHTotal)) then do
    address "LOGPROC" 'Putlog 'loggroup time() Line "Refusing Request! Human Total free bytes exceeded!"
    if human then call send(' Refusing Request! Exceeded Total Free bytes for unregistered users!\r\n') 
    LogBuf=LogBuf||date() time() Line' Refusing request from 'remote_sysop' of 'remote_address' -> Humans exceeded Total Free Bytes'lf
    call writepkt('File request terminated: Exceeded Total Free Bytes - Registration required'cr)
    Signal GoodBye
end
/* Read the REQ file */
if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Reading "Infile 
NumRequested=1
if ~open('in',Infile,'R') then do
    address "LOGPROC" 'Putlog 'loggroup time() Line "Unable to read "Infile
    LogBuf=LogBuf||date() time() Line Infile' from 'remote_sysop' of 'remote_address' -> Not Found'lf
    Signal GoodBye
end
do while ~eof('in')
    FName.NumRequested=upper(readln('in'))
    MName.NumRequested=""
    if left(FName.NumRequested,1)=";" then iterate
    if left(FName.NumRequested,3)="---" then iterate
    if right(FName.NumRequested,1)=D2C('13') then FName.NumRequested=left(FName.NumRequested,Length(FName.NumRequested)-1)
    if length(FName.NumRequested) < 1 then leave
    Update.NumRequested=""
    Password.NumRequested=""
    if words(FName.NumRequested) > 1 then do
        if left(word(FName.NumRequested,2),1)="!" then Password.NumRequested=SubStr(Word(FName.NumRequested,2),2)
        if left(word(FName.NumRequested,2),1)="+" then Update.NumRequested=Word(FName.NumRequested,2)
        else if left(word(FName.NumRequested,2),1)="-" then Update.NumRequested=Word(FName.NumRequested,2)
        else if words(FName.NumRequested)=3 then do    
            if left(word(FName.NumRequested,3),1)="!" then Password.NumRequested=SubStr(Word(FName.NumRequested,3),2)
            if left(word(FName.NumRequested,3),1)="+" then Update.NumRequested=Word(FName.NumRequested,3)
            else if left(word(FName.NumRequested,3),1)="-" then Update.NumRequested=Word(FName.NumRequested,3)
        end
        FName.NumRequested=word(FName.NumRequested,1)
    end
    NumRequested=NumRequested+1
end
call close('in')
/* Number of Files Requested */
NumRequested=NumRequested-1

if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Requests:"NumRequested

/* Find requested files */
call FindRequests

/* Send result message */
if debug then address "LOGPROC" 'Putlog 'loggroup time() Line "Building Response message"
do a=1 to NumRequested
    if verbose then address "LOGPROC" 'Putlog 'loggroup time() Line "Request:"a Fname.a SendFName.a "Sent:"SendFName.a.SentFiles
    
    if (MaxReqNames > 0) & (a > MaxReqNames) then SendFName.a.SentFiles=1
    do b=1 to SendFName.a.SentFiles
        if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Request:"a Fname.a "Sent:"SendFName.a.b
        if SendFName.a.b="File Not Found" then do
            MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
            MsgBuf=MsgBuf||'Error: File Not Found or Password Missing/Invalid'cr||cr
            LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: File Not Found'lf
            if human then call send(' 'FName.a' -=> Error: File Not Found\r\n')
            iterate
        end
        if SendFName.a.b="File Not Available" then do
            MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
            MsgBuf=MsgBuf||'Error: File Is Not Available On This System'cr||cr
            LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: File Missing ['Password.a']'lf
            if human then call send(' 'FName.a' -=> Error: File Missing\r\n')
            iterate
        end
        if SendFName.a.b="Bad Password" then do
            MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
            MsgBuf=MsgBuf||'Error: File Not Found or Password Missing/Invalid'cr||cr 
            LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Bad Password ['Password.a']'lf
            if human then call send(' 'FName.a' -=> Error: Bad Password\r\n')
            iterate
        end
        if SendFName.a.b="Too Many Bytes" then do
            MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
            MsgBuf=MsgBuf||'Error: Request Exceeded Maximum Requests or Byte count'cr||cr 
            LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Request Exceeded Byte count'lf
            if human then call send(' 'FName.a' -=> Error: Request Exceeded Byte count\r\n')
            iterate
        end
        if MaxReqNames>0 & a>MaxReqNames | SendFName.a.b="Too Many Requests" then do
            MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
            MsgBuf=MsgBuf||'Error: Request Exceeded Maximum Requests or Byte count'cr||cr 
            LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Request Exceeded Maximum Requests'lf
            if human then call send(' 'FName.a' -=> Error: Request Exceeded Maximum Requests\r\n')
            iterate
        end
        if SendFName.a.b="Exceeded Daily Limit" then do
            MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
            MsgBuf=MsgBuf||'Error: Request Exceeded Daily Limit for Human requesters'cr||cr 
            LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: Request Exceeded Daily Limit for Human requesters'lf
            if human then call send(' 'FName.a' -=> Error: Request Exceeded Daily Limit\r\n')
            iterate
        end
        if SubWord(SendFName.a.b,1,3)="Update request failed:" then do
            MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
            MsgBuf=MsgBuf||'Date : 'JDate.a.b||cr'Error: 'SendFName.a.b||cr||cr
            LogBuf=LogBuf||date() time()' 'FName.a' -=> Error: 'SendFName.a.b||lf
            if human then call send(' 'FName.a' -=> Error: Update request failed\r\n')
            iterate
        end;else do
            Sent=Sent+1
            if MName.a.b~="" then do
                MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a' Sent:'MName.a.b||cr
                MsgBuf=MsgBuf||'Size : 'FSize.a.b' bytes'cr'Desc : 'FDesc.a.b||cr||cr
                LogBuf=LogBuf||date() time()' 'FName.a '['MName.a.b'] ('FSize.a.b' bytes)'lf
            end;else do
                MsgBuf=MsgBuf||'Request Number 'a  'Requested: 'FName.a||cr
                MsgBuf=MsgBuf||'Size : 'FSize.a.b' bytes'cr'Desc : 'FDesc.a.b||cr||cr
                LogBuf=LogBuf||date() time()' 'FName.a' ('FSize.a.b' bytes)'lf
            end
        end
    end
end

if (MaxReqNames > 0) & (NumRequested > MaxReqNames) then do
   MsgBuf=MsgBuf||'Remaining Requests skipped for exceeding request limits'cr
   if human then call send(' 'FName.a' -=> Error: Remaining Requests skipped for exceeding request limits\r\n'
end
MsgBuf=MsgBuf||cr'Sending 'Sent' file(s), 'TBytes' bytes this request.'cr
MsgBuf=MsgBuf||cr'You have made a total of 'NumReqs+1' FileRequest(s) for 'ReqFiles+Sent' files ('ReqBytes+TBytes' bytes)'cr
MsgBuf=MsgBuf||cr'Files were requested from 'script sv' on 'host_address||cr

call writepkt(MsgBuf)

LogBuf=LogBuf||date() time()' Sending 'Sent' file(s), 'TBytes' bytes this request'lf
LogBuf=LogBuf||date() time()' Totals: 'NumReqs+1' request(s) for 'ReqFiles+Sent' file(s) ('ReqBytes+TBytes' bytes)'lf

/* Update the account */
AccBuf=AccBuf||FirstDate||lf||Date()||lf
AccBuf=AccBuf||NumReqs+1||lf||ReqFiles+Sent||lf
AccBuf=AccBuf||ReqBytes+TBytes||lf 
AccBuf=Accbuf||LastBytes+TBytes||lf||UserCalls||lf
Signal GoodBye

FindRequests:
Num=NumRequested /* Limit number of REQUEST NAMES to MaxReqNames */
if (MaxReqNames~=0) & (NumRequested > MaxReqNames) then Num=MaxReqNames

do ReqCount=1 to Num
    address "LOGPROC" 'PutLog 'loggroup time() Line script "Searching for Req:"ReqCount":"FName.ReqCount" in "FREQLST
    SentCount=1;notfound=1
    SendFName.ReqCount.SentCount="File Not Found"
    if SortedLst=TRUE then sopt="-s"
    if MatchFirst=TRUE then do
        if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Executing: Fsearch >"tlist FREQLST Fname.ReqCount "-o" sopt
        address COMMAND 'Fsearch >'tlist FREQLST Fname.ReqCount '-o' sopt
    end;else do
        if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Executing: Fsearch >"tlist FREQLST Fname.ReqCount sopt
        address COMMAND 'Fsearch >'tlist FREQLST Fname.ReqCount sopt
    end

    if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Searching match list:"tlist
    call open('tq',tlist,'r')
    do while ~eof('tq')
        SearchResult=strip(readln('tq'))
        if SearchResult="" then Iterate
        if SearchResult="!@ No match found" then do
            SendFName.ReqCount.SentCount="File Not Found"
            Leave
        end
        if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "SearchResult:"SearchResult
        if MatchFirst=TRUE then do
            /* if not a magic name then we send only the first file matched */
            if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "MATCHFIRST:"SearchResult
            call sendifok
            Leave
        end
        if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "MULTIMATCH:"SentCount SearchResult
        call sendifok
        SentCount=SentCount+1
        if MultiMagic=TRUE | MatchFirst=FALSE then Iterate
            else Leave
    end /* tag matches in search list */
    call close('tq') 
    if ~debug then call delete(tlist)
    if SentCount=0 then SendFname.ReqCount.SentFiles=1
        else if SentCount > 1 then SendFname.ReqCount.SentFiles=SentCount-1  
            else SendFname.ReqCount.SentFiles=SentCount
    if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "SentCount:"SentCount SendFname.ReqCount.SentFiles
end /* each request NAME */
Return

sendifok:
/* check file match for bytes exceeded, password match, update request */
sendit=TRUE
if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Checking:" SearchResult
if index(SearchResult,'!')=0 then do
    if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "No Password Set:" SearchResult
    SendFname.ReqCount.SentCount=upper(subword(SearchResult,2))
end;else do 
    if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Password Check:" SearchResult "{"upper(Password.ReqCount)"}"
    if upper(Password.ReqCount)~=strip(upper(delstr(word(SearchResult,2),1,1))) then do
        if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Bad Password!"
        SendFName.ReqCount.SentCount="Bad Password"
        sendit=FALSE
    end;else do
        SendFname.ReqCount.SentCount=upper(subword(SearchResult,3))
    end
end

if ~sendit then return sendit

if ~exists(SendFName.ReqCount.SentCount) then do
    if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "File Missing:"SendFName.ReqCount.SentCount
    SendFName.ReqCount.SentCount="File Not Available"
    sendit=FALSE
end;else do
    FName.ReqCount.SentCount=get_fn(SendFName.ReqCount.SentCount)
    filestats=statef(SendFName.ReqCount.SentCount)
    FSize.ReqCount.SentCount=word(filestats,2)
    if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line FName.ReqCount.SentCount" Size:" FSize.ReqCount.SentCount
    TBytes=TBytes+FSize.ReqCount.SentCount
    if MaxBytes > 0 then do
        if (TBytes > MaxBytes) then do
            SendFName.ReqCount.SentCount="Too Many Bytes"
            TBytes=TBytes-FSize.ReqCount.SentCount
            sendit=FALSE
        end
    end

    if ~Human & (MaxDaily > 0) then do
        if (TBytes+LastBytes > MaxDaily) then do
            SendFName.ReqCount.SentCount="Exceeded Daily Limit"
            TBytes=TBytes-FSize.ReqCount.SentCount
            sendit=FALSE
        end
    end 

    if Human & (MaxHDaily > 0) then do
        if (TBytes+LastBytes > MaxHDaily) then do
            SendFName.ReqCount.SentCount="Exceeded Daily Limit"
            TBytes=TBytes-FSize.ReqCount.SentCount
            sendit=FALSE
        end
    end

    FDesc.ReqCount.SentCount=subword(filestats,8)
    if FDesc.ReqCount.SentCount="" then FDesc.ReqCount.SentCount="Sorry, description is unavailable"

    if DLGfd then FDesc.ReqCount.SentCount=get_dlgfd()
    else if TAdesc then FDesc.ReqCount.SentCount=get_tadesc()

    if Update.ReqCount ~="" then do
        if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "Update Request:"Update.ReqCount
        UDT.ReqCount=left(Update.ReqCount,1)
        if substr(Update.ReqCount,2,1)="U" then do
            Update.ReqCount=SubStr(Update.ReqCount,3)
            UDT.Human=TRUE
            if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "QS/RFS Update Request:"Update.ReqCount
        end;else do
            Update.ReqCount=SubStr(Update.ReqCount,2)
            UDT.Human=FALSE
            if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "FTS006 Update Request:"Update.ReqCount
        end
        if UDT.Human then do
            if length(strip(Update.ReqCount)) >6 then do    
                cktime=TRUE
                cmd='List DATES 'SendFName.ReqCount.SentCount' LFORMAT="%D%T" TO 'ulist 
            end;else do   
                cktime=FALSE
                cmd='List DATES 'SendFName.ReqCount.SentCount' LFORMAT="%D" TO 'ulist
            end
            Address Command cmd
            call open('UFile',ulist,'R')
            UpDt.ReqCount.SentCount=readln('UFile')
            call close('UFile')
            if ~debug then call Delete(ulist)
            if cktime then UpDt.ReqCount.SentCount=space(translate(UpDt.ReqCount.SentCount,"",":"),0)
            if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "File Date Read:"UpDt.ReqCount.SentCount

            Mon=right('00'||(pos(substr(UpDt.ReqCount.SentCount,4,3),'JanFebMarAprMayJunJulAugSepOctNovDec')+2)/3,2)

            if cktime then Jdate.ReqCount.SentCount=right(UpDt.ReqCount.SentCount,2)||Mon||left(UpDt.ReqCount.SentCount,2)||right(UpDt.ReqCount.SentCount,8)
                else Jdate.ReqCount.SentCount=right(UpDt.ReqCount.SentCount,2)||Mon||left(UpDt.ReqCount.SentCount,2)

            if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line "File Date Calc:"Jdate.ReqCount.SentCount
        end;else do
            /* FTS006 update request */
            x=statef(SendFName.ReqCount.SentCount)
            JDate.ReqCount.SentCount=(86400 * 365 * 8)+(2 * 86400)+(((word(x,5))*86400)+(word(x,6)*60))
        end
        if (UDT.ReqCount="+") & (JDate.ReqCount.SentCount < Update.ReqCount) then do
            SendFName.ReqCount.SentCount="Update request failed: File older than requested."
            sendit=FALSE
        end
        if (UDT.ReqCount="-") & (JDate.ReqCount.SentCount > Update.ReqCount) then do
            SendFName.ReqCount.SentCount="Update request failed: File newer than requested."
            sendit=FALSE
        end
        if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line SendFName.ReqCount.SentCount
    end 
end
if sendit then do
    /* get FileName returned for a magic request */
    Mname.ReqCount.SentCount=get_fn(SendFname.ReqCount.SentCount)
    if Fname.ReqCount=Mname.ReqCount.SentCount then Mname.ReqCount.SentCount=""
    if ~debug then call queueadd(SendFName.ReqCount.SentCount,XQ_IMMEDIATE)
        else address "LOGPROC" 'PutLog 'loggroup time() Line script "Queued" SendFname.ReqCount.SentCount
end
return sendit

writepkt:
if Human then do
    cr='0a'x;packet_name="T:"||translate(strip(remote_sysop),'_'," ")||"."||date("I")||time("S")
    pbuf=""
end;else do
    magicnum=x2d(time('s'))+randu(x2d(Pragma('ID')))+ (randu(x2d(time('s')) ) * 999999)+(random() * 1000000)  
    serial=reverse(right("0000"x||c2x(magicnum), 8))
    packet_name="T:"||serial||".PKT"

    /* create some data in packet format */
    d=date("S");t=time("N")
    parse var t hh":"mm":"ss
    yr=reverse(right("00"x||d2c(left(d,4)),2))
    mh=reverse(right("00"x||d2c((substr(d,5,2)-1)),2))
    dy=reverse(right("00"x||d2c(substr(d,7,2)),2))
    hr=reverse(right("00"x||d2c(hh),2))
    mn=reverse(right("00"x||d2c(mm),2))
    sc=reverse(right("00"x||d2c(ss),2))

    zo=reverse(right("00"x||d2c(myaddress.zone),2))
    ndo=reverse(right("00"x||d2c(myaddress.node),2))
    nto=reverse(right("00"x||d2c(myaddress.net),2))
    po=reverse(right("00"x||d2c(myaddress.point),2))

    zd=reverse(right("00"x||d2c(hisaddress.zone),2))
    ndd=reverse(right("00"x||d2c(hisaddress.node),2))
    ntd=reverse(right("00"x||d2c(hisaddress.net),2))
    pd=reverse(right("00"x||d2c(hisaddress.point),2))

    pbuf=ndo||ndd||yr||mh||dy||hr||mn||sc||copies("00"x,2) ||"0200"x||nto||ntd||"DA"x||d2c(substr(sv,2,2))||copies("00"x, 8)
    pbuf=pbuf||zo||zd||copies("00"x,2)||reverse(right("01"x||"00"x,2))||"00"x||d2c(substr(sv,5,2))||reverse(right("00"x||"01"x,2))
    pbuf=pbuf||zo||zd||po||pd||"ROOF"||"0200"x||ndo||ndd||nto||ntd||"11000000"x||left(date(),6) right(date(),2) "" time()||"00"x||remote_sysop||"00"x
    pbuf=pbuf||sysop||"00"x||"Results of your file request"||"00"x
    if myaddress.zone~=hisaddress.zone then pbuf=pbuf||"01"x||"INTL" hisaddress.zone":"hisaddress.net"/"hisaddress.node myaddress.zone":"myaddress.net"/"myaddress.node||cr
        else pbuf=pbuf||"01"x||"MSGTO:" hisaddress.zone":"hisaddress.net"/"hisaddress.node||cr
    if myaddress.point~=0 then pbuf=pbuf||"01"x||"FMPT" myaddress.point||cr
    if hisaddress.point~=0 then pbuf=pbuf||"01"x||"TOPT" hisaddress.point||cr
    pbuf=pbuf||"01"x||"MSGID: "myaddress.zone':'myaddress.net'/'myaddress.node'.'myaddress.point' 'd2x((date('I') * 86400)+time("S")+252460600)||cr||"01"x||"PID: Roof/"script sv||cr
end /* Not Human */

    pbuf=pbuf||"      Presenting "script sv", the ARexx/WPL/XFREQ File Request Server"cr||cr
    if Header~="" then pbuf=pbuf||cr||Header||cr
    if exists(AcctFile||'.M') then call addmsg
    if FirstCall~="" then pbuf=pbuf||cr||FirstCall||cr

    if Human then pbuf=pbuf||cr'The following are the results of your Grab session:'cr||cr
        else pbuf=pbuf||cr'The following are the results of your File Request:'cr||cr

    pbuf=pbuf||arg(1)||cr||cr

    If Tail~="" & ~Human then  pbuf=pbuf||cr||Tail||cr

    If Human & Listed & VHuman~="" then pbuf=pbuf||cr||VHuman||cr

    pbuf=pbuf||cr||"--- The Roof File Request Server "sv||cr||cr
    if ~Human then pbuf=pbuf||"000000"x

    if ~open('packet',packet_name,"W") then do
        address "LOGPROC" 'PutLog 'loggroup time() Line script "Couldn't open packet-file ["packet_name"]"
        return 20
    end
    call writech('packet',pbuf)
    call close('packet')
    if verbose then address "LOGPROC" 'PutLog 'loggroup time() Line script "Queueing response packet" packet_name
    call queueadd(packet_name, XQ_IMMEDIATE+XQ_DELETE)
return 0

    
addmsg:
call open('am',AcctFile||'.M','R')
pbuf=pbuf||" The sysop left this personal message for you:"||cr
do while ~eof('am')
    mline=readln('am')
    y=pos(cr,mline)
    if y~=0 then pbuf=pbuf||mline
        else pbuf=pbuf||mline||cr
end
call close('am')
call delete(AcctFile||'.M')
return


send:
Address VALUE upper(wplport)||line
'Print' quote||arg(1)||quote
'Send' quote||arg(1)||quote
Address
return

queueadd:
if debug then return
file=upper(arg(1))
flags=arg(2)
sendas=get_fn(file)
work=NULL
QUERY.XQ_NAME=file
QUERY.XQ_SITE=xfq_site_object
work=XfqFindWork(QUERY)
if work=NULL then do
    if ~XfqAddWorkQuick(remote_address,file,sendas,120,flags) then do
        address "LOGPROC" 'PutLog 'loggroup time() Line script 'Queue 'file' Failed:'XFQERRORMSG remote_address
        drop XFQERRORCODE XFQERRORMSG
    end;else do
        address "LOGPROC" 'PutLog 'loggroup time() Line script 'Queued 'file' as' sendas
        if Human then call send(' Sending 'file' as 'sendas'\r\n')
    end
end;else do
    call XfqUnlockWork(work)
    address "LOGPROC" 'PutLog 'loggroup time() Line script file 'already queued'
end
if work~=NULL then call XfqDropObject(work)
return 0

get_dlgfd:
fn=translate(FDesc.ReqCount.SentCount,"",'1b'x)
if ~open('dx',fn,'r') then return "Sorry, DLG description is unavailable"
tmpbuf=readch('dx',word(statef(fn),2))
call close('dx')        
return substr(tmpbuf,lastpos('00'x,tmpbuf)+1)

get_tadesc:
fn=SendFName.ReqCount.SentCount||'.desc'
if ~open('dx',fn,'r') then return "Sorry, TransAmiga description is unavailable"
tmpbuf=readch('dx',word(statef(fn),2))
call close('dx')        
return tmpbuf

/* get filename */
get_fn:
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)


setconfig:
if ~open('cfg',"RAM:RFS.cfg",'r') then 
    if ~open('cfg',"CFG:RFS.cfg",'r') then address "LOGPROC" 'PutLog 'loggroup time() Line 'RFS cfg failed'
    do while ~eof('cfg')
        x=readln('cfg')
        if x="" | left(x,1)=" " | left(x,2)='/*' | left(x,2)='*/' then iterate
        interpret x
    end
call close('cfg')
return

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


Syntax:
call template_oops "Syntax(RC="||RC||")" sigl RC
IOErr:
call template_oops "IOErr" sigl
template_oops: 
parse arg what badline code
if code~="" then  LogBuf=LogBuf||date() time() "ERR:"what errortext(code)||lf
    else LogBuf=LogBuf||date() time() "ERR:"what||lf
LogBuf=LogBuf||date() time() "ERR: Line:"badline strip(sourceline(badline))||lf
GoodBye:
x=XfqReleaseMailer(xfq_site_object)
call XfqDropObject(xfq_site_object)
if work~=NULL then call XfqDropObject(work)
call XfqClose()

if AccBuf~="" then do
    address "LOGPROC" 'PutLog 'loggroup time() Line "Updating account"
    call open('Acct',AcctFile,'W')
    call Writech('Acct',AccBuf||lf)
    call close('Acct')
end

LogBuf=LogBuf||date() time()' RFS session Ending'lf

if LogFile~="" then do
    if exists(LogFile) then call open('log',LogFile,'A')
        else call open('log',LogFile,'W')
    call writech('log',LogBuf||lf)
    call close('log')
end;else do
    i=1
    loglen=length(LogBuf)
    do while i < loglen+1
        alen=pos('0a'x, LogBuf, i)-i
        aline=substr(body,i,alen)
        address "LOGPROC" 'PutLog 'loggroup Line aline
        i=i+alen+1
    end
end
if ~debug then call delete(infile)
address "LOGPROC" 'PutLog 'loggroup time() Line 'RFS session with' remote_address 'terminated'
Exit

/*
  I've modified the routine to fetch the file comments from a DLG system
and am including it here for you to implement into RFS if you would like.
Also included is the routine to get the descriptions from an Excelsior!
BBS.

Call with something like this:

Info = StateF(FileName)
Path = SubWord(Info,8)
Comment = GetDLGDesc(Path)
If Comment = "NOCOMMENT" then Comment = DefaultComment
*/
/*
GetDLGDesc: Procedure
  Arg DLGName
  FN = Translate(DLGName,"","1b"x)
  If ~Exists(FN) then Return "NOCOMMENT"
  If ~Open('dx',FN,'r') then Return "NOCOMMENT"
  TmpBuf = ReadCh('dx',Word(StateF(FN),2))
  TmpBuf = SubStr(TmpBuf,LastPos('00'x,TmpBuf)+1)
  TmpBuf = Translate(TmpBuf,' ','0a'x)
  If Pos('0d'x,TmpBuf)>0 then TmpBuf=SubStr(TmpBuf,1,Pos('0d'x,TmpBuf)-1)
  Call Close('dx')
  Drop DLGName
  Return Strip(TmpBuf)
*/

/*
For  the Excelsior BBS option, I use this routine to fetch the description.
A  bit more complex, but that's the nature of the data files that Excelsior
uses.
    Used by permission Roger Clark

Comment=GetExcelDesc(Path||FileName)
If Comment="NOCOMMENT" then comment=DefaultComment
*/
/*
GetExcelDesc: Procedure
Arg FilePath
TempComment = ""
TempPath = Translate(FilePath," ",":")
TempPath = Translate(TempPath," ","/")
TempFile = Word(TempPath,Words(TempPath))
TempPath = Left(FilePath,Length(FilePath)-Length(TempFile))
If ~Exists(TempPath"_itemdata") then Return "NOCOMMENT"
Call Open("Items",TempPath"_itemdata","R")
FSize = Word(StateF(TempPath"_itemdata"),2)
fileX = 0
Do Forever
    If fileX * 170 >= FSize then Break
    FileName = ""
    Call Seek("Items",(filex*170),"B")
    Do Forever
        Char=ReadCH("Items")
        If Char="00"x then Leave
        FileName=FileName||Char
    End
    fileX=fileX+1
    If Upper(FileName) = Upper(TempFile) then Do
        Call Open("Data",TempPath"_Comments","R")
        OffSet = ((fileX-1) * 170) + 110
        Call Seek("Items",OffSet,"B")
        Pos=C2D(ReadCH("Items",4))
        Call Seek("Data",Pos,"B")
        Do Until Left(EComment,1) = "01"x
            EComment = ReadLn("Data")
            TempComment = TempComment||"0a"x||EComment
        End
        Call Close("Data")
        TempComment = Translate(TempComment,"","01"x)
        TempComment = Strip(TempComment,"B","0a"x)
        TempComment = Translate(TempComment,"0d"x,"0a"x)
        If Pos("0d"x,TempComment) > 0 then Do
            NComment = ""
            Do CLoop = 1 to Length(TempComment)
                NComment = NComment||SubStr(TempComment,CLoop,1)
                If SubStr(TempComment,CLoop,1)="0d"x then NComment=NComment||"       "
            End
            TempComment = Strip(NComment,"T")
        End
    End
End
Call Close("Items")
If TempComment = "" then TempComment = DefaultComment
Return TempComment
*/
/*
Today=Date("S")
CompDate=Right(Today,2)||" "||SubStr("JanFebMarAprMayJunJulAugSepOctNovDec",((SubStr(Today,5,2)-1)*3)+1,3)||" "||SubStr(Today,3,2)||"  "||Time()
pbuf=pbuf||CompDate||"00"x||remote_sysop||"00"x
*/