/**/
v="$VER: Smsg Rexx   Packet Creation for Shelter  Williamson 54.02"
/*
    The  first  parameter is a ECHO TAGNAME. An echomail packet will be
    written and placed in the domains INBOUND directory.
    If the Echo is in a domain other than fidonet use the form:
    echotag@domain
*/

/* These two are mutually exclusive, if both are set only hardcr    */ 
/* will be effective. If neither set, no processing will be done    */
cvteol=1        /* if 1, CR LF are converted to CR only             */
hardcr=0        /* if 0, hard carriage returns (0dx) will not be    */
                /* added to the input text file                     */
                /* if 1, linefeeds are stripped and hard carriage   */
                /* returns will be added                            */
frompoint99=1   /* if 0, Net/Node will be used in SeenBy and Path   */
                /* if 1, PointNet/99 is used in SeenBy and Path     */
pointnet=30730  /* if frompoint99=1, then this will be the net used */
                /* in SeenBy                                        */
doimport=1      /* if 1, import our echomail packets, using the cmd */
                /* set as IMPPKT                                    */

auditdir="OS4:Mback/Inhold"
                /* If not set to "", all mail created by SMSG       */
                /* will be copied to this directory                 */

options results
options failat 20
signal on syntax  
signal on halt
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 support.library !"
        exit 20
    end
sv="v"||right(v,5)
script='Smsg'
if arg()=0 then call usage
log=show('P','ROOFLOG')
wspec='RAW:0/10/640/100/'script sv'/INACTIVE/AUTO/SCREEN'||GetClip('ASYNCSCREEN')
call close('STDOUT'); open('STDOUT',wspec,'w')  
call close('STDIN');call open('STDIN','*','R')
nl='0a'X
cr='0d'X
lf='0a'x
indir=addslash(dequote(GetClip('INDIR')))
mailer=GetClip('SHELTER')
rver=mailer||" v"||GetClip('GENVER')
pvmaj=substr(sv,2,2) ;  pvmin =substr(sv,5,2)
if mailer="ROOF" then def_domain=GetClip('DOMAIN')
else def_domain=GetClip('FTNDOMAIN')
dl=GetClip('DOMAINLIST')

parse arg tag infile '"'fromname'"' '"'dsysop'"' subject
infile=strip(infile)
subject=strip(subject)
tag=upper(tag)

domidx=lastpos('@',tag)
if domidx ~=0 then do
    ddomain=substr(tag,domidx+1)
    tag=left(tag,(domidx-1))
end;else do
    ddomain=def_domain
end    
call myadr(ddomain)
if frompoint99 then do
    point=99
    fakenet=pointnet'/'point
    ftn_seenby=fakenet
    ftn_path=fakenet
end;else do
    ftn_seenby=net'/'node
    ftn_path=net'/'node
end

/* setup dzone,dnet, dnode, dpoint */
destadr=make5d(strip(zone":"net"/"node".0"))

singleinbound=GetClip('DOMAINAWARE')=="TRUE"
if singleinbound then pktdir=indir
   else  pktdir=indir||ddomain"/"

pktname=pktdir||get_packetname(pktdir)||".PKT"
say 'TagName: 'tag
say 'From:    'fromname
say 'Text:    'infile
say 'Subject: 'subject
if exists(pktname) then do
    call PutLog('Appending to' pktname 'for' destadr,60,10)
    append=1
    pktlen=word(statef(pktname),2)
    if ~open('packet',pktname,'A') then do
        call PutLog("Couldn't append to packet-file" pktname,10,10)
        exit 20
    end
    phdrpos=seek('packet',-2,'E')
    call PutLog('Length:'pktlen'   Pos:'phdrpos,70,70)
end;else do
    call PutLog('Creating ECHO packet' pktname 'for' destadr,60,10)
    append=0
    if ~open('packet',pktname,'W') then do
        call PutLog("Couldn't open packet-file" pktname,10,10)
        exit 20
    end
end

tlen=word(statef(infile),2)
if ~open('text',infile,'R') then do
    call PutLog("Couldn't read text file" infile,10,10)
    exit 20
end

if append then call PutLog('Appending 'infile'['tlen'] to 'pktname'['pktlen']@['phdrpos']',60,10)
    else call PutLog('Writing 'infile'['tlen'] to 'pktname,60,10)

revmaj=d2c(pvmaj);revmin=d2c(pvmin)
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(zone),2));ndo=reverse(right("00"x||d2c(node),2))
nto=reverse(right("00"x||d2c(net),2));po=reverse(right("00"x||d2c(point),2))
zd=reverse(right("00"x||d2c(dzone),2));ndd=reverse(right("00"x||d2c(dnode),2))
ntd=reverse(right("00"x||d2c(dnet),2));pd=reverse(right("00"x||d2c(dpoint),2))
cw=reverse(right("00"x||"01"x,2));cv=reverse(right("01"x||"00"x,2)) 
if append then phdr=""   
else phdr=ndo||ndd||yr||mh||dy||hr||mn||sc||copies("00"x,2)||"0200"x||nto||ntd||"DA"x||revmaj||copies("00"x, 8)||zo||zd||copies("00"x,2)||cv||"00"x||revmin||cw||zo||zd||po||pd||"ROOF"
phdr=phdr||"0200"x||ndo||ndd||nto||ntd||"00000000"x||left(date(),6) right(date(),2) "" time()||"00"x||dsysop||"00"x||fromname||"00"x||subject||"00"x||"AREA:"||tag||cr
magicnum=x2d(time('s'))+randu(x2d(Pragma('ID')))+(randu(x2d(time('s')))*999999)+(random()*1000000)  
serial=reverse(right("0000"x||c2x(magicnum),8))
phdr=phdr||"01"x||"MSGID: "zone':'net'/'node'.'point'@'bitor(domain,'20'x) serial||cr||"01"x||"PID: "rver||cr
if hardcr then do while ~eof('text')
    phdr=phdr||readln('text')||cr
end;else if cvteol then do
    do while ~eof('text')
        line=readln('text')
        y=pos(cr,line)
        if y ~=0 then phdr=phdr||line
            else phdr=phdr||line||cr
    end
    phdr=phdr||cr
end;else do
    do while ~eof('text')
        phdr=phdr||readch('text',tlen)
    end
    phdr=phdr||cr
end
call close('text')
phdr=phdr||cr||"--- "rver||cr||" * Origin: The Shelter Mailer  ("zone":"net"/"node"."point"@"bitor(domain,'20'x)")"||cr||"SEEN-BY: "||ftn_seenby||cr||"01"x||"PATH: "||ftn_path||cr||"00"x||"0000"x
call writech('packet',phdr)
call close('packet')
f=get_fn(pktname)
note='To:'ddomain'#'dzone':'dnet'/'dnode'.'dpoint 'File:'f
address COMMAND 'FileNote' pktname '"'||note||'"'

if auditdir ~="" | auditdir ~=NULL then do
    auditdir=addslash(auditdir)
    address COMMAND 'Copy 'pktname auditdir 'clone'
end

if doimport then do
    if mailer="ROOF" then cmd=GetClip('IMPPKT') domain pktname
        else cmd=GetClip('PKTRECD')
    call PutLog('Executing:'cmd,30,10)
    address COMMAND cmd
end
exit

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

/* 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)

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

make5d: procedure expose dl def_domain ddomain dzone dnet dnode dpoint domain zone net node point
    site_address=arg(1)
    select
        when index(site_address, "#") > 0 then parse var site_address ddomain "#" dzone ":" dnet "/" dnode "." dpoint
        when index(site_address, ":") > 0 then parse var site_address dzone ":" dnet "/" dnode "." dpoint
        when index(site_address, "/") > 0 then parse var site_address dnet "/" dnode "." dpoint
        when index(site_address, ".") > 0 then parse var site_address dnode "." dpoint
        when left(site_address, 1)="." then parse var site_address "." dpoint
        otherwise parse var site_address dnode "." dpoint
    end

    if ddomain="" | ddomain='DDOMAIN' then cfgaddress=GetClip('HOST.ADDRESS.'||def_domain)
        else cfgaddress=GetClip('HOST.ADDRESS.'||ddomain)
    parse var cfgaddress zone ":" net "/" node "." point
    if dpoint=""|dpoint='DPOINT'then dpoint=0
    if dnet =""|dnet ='DNET' then dnet=net
    if dnode=""|dnode='DNODE' then dnode=node
    if dzone=""|dzone='DZONE' then dzone=zone
    if ddomain=""|ddomain='DDOMAIN' then do
        ddomain=0
        x=find(dl,z)
        if x~=0 then ddomain=word(dl,x-1)
        if ddomain=0 then ddomain=def_domain
    end

    if ~datatype(dzone,'n')|~datatype(dnet,'n')|~datatype(dnode,'n')|~datatype(dpoint,'n') then do
        call PutLog('make5d: Invalid address ['site_address']',50,10)
        return 0
    end
return(ddomain'#'dzone':'dnet'/'dnode'.'dpoint)

myadr:
    domain=upper(arg(1))
    myaddress=GetClip('HOST.ADDRESS.'domain)  
    parse var myaddress zone ":" net "/" node "." point
return zone':'net'/'node'.'point

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

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

cleanup:
return 0

/*  Error handling */
break_c:
break_d:
    call PutLog('User abort',10,10)
    call cleanup
    exit 10
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" sigl 
halt:
        call template_oops "Halt" sigl 

template_oops:
        parse arg what badline code
        if code ~="" then call PutLog('ERR: Line' badline what errortext(code),10,10)
            else call PutLog('ERR: Line 'badline what,10,10)
        call cleanup
        exit(40)
/**/

usage:
    say script sv' by Robert Williamson'
    say '   EchoTagName[@domain] InputFile "Origin Name" "Destination Name" Subject'
    say '       where echotagname must be a valid TAGNAME'
    say '       The EchoMail message will be placed in your inbound directory'
    say '       for your default domain or the requested domain and imported'
    say '   Note:'
    say '   When called from another rexx script, double quotes should be quoted'
    say '   with single quotes.'
    say ''
exit 0