/*
TO DO :
 Check broadcast features of MESSAGE (and document it )
 Formatting of message box output

 The SREhttp/2 utility package.
   Note that this handles several different "addons".
   To call them, you need to have several entries in PRELOADS.CFG of the form:
      load_addon= sendfile  sre_Util.cmd

   The supported utilities are:

      GET_URL
          Get a URL and copy it to a local file.  

      PUT_FILE
          Process a form with input element type=file.
          This will cause a Html 3.0 (or netscape 2.01) browser
          to send a file.  PUT_FILE will parse/store this file

     MESSAGE 
          Manipulate SREhttp/2's "message boxes". Message boxes
          can be used as a simple bbs system.


    SENDFILE or SEND_FILE
        (invoked with SENDFILE?filename&access=user&headers=url_encodded_headerlist)
        ... recorded file transfer with "double checked sending".
        Differs from a standard GET
        in that we increment counters for this filename 
        Also, we only record if actual reciept occured (as determined by
        non-loss of connection)
        Also, multiple files can be sent (as a multiple-part send)


Note: several parameters are read from the SRE_UTIL.CFG file. SRE_UTIL.CFG
      should be in the (possibly host specific) CFG directory of SREhttp/2
      After the first read, these parameters are saved to memory for quicker
      retrieval.


*/

sre_utilities:

parse arg list,servername,verb,tempfile,,
          prog_file,reqnum,verbose,client_ip,privset,,
          uri,host_nickname,id_info,aiter,attribs,seluse




if verb=" " then do
   say "This SREhttp/2 procedure is not meant to be run in standalone mode "
   exit
end  

signal on error name errx 
signal on syntax name errx
signal on novalue name errx 

listorig=list

parse var prog_file prog_file ','  mproc
parse upper var seluse  which_util '?' .    /* which utility? use the URI to determine */
which_util=strip(which_util)
if pos(left(which_util,1),'\/')>0  then which_util=substr(which_util,2)

parse var privset norm_privset ',' secret_privset
rcode=''

treset=sre_value('H2_CFG_RESET',,'SRE')
llv=sre_value('LISTEN_SOCK',,'SRESYS')  /* unique to this instance of sre2003 */
llv=llv||'__'||treset

was_init=sreh2_value('SU_CURRENT_PROCESS',,host_nickname,,1)
if was_init='' | was_init<>llv then do               /* read from the cfg file */
   rcode=sreh2_sre_util_cfg(host_nickname)
   if rcode<>1 then return rcode
   was_init=sreh2_value('SU_CURRENT_PROCESS',llv,host_nickname)
end 

upload_dir=sreh2_value('SU_UPLOAD_DIR',,host_nickname)
upload_maxsize=sreh2_value('SU_UPLOAD_MAXSIZE',,host_nickname)
upload_minfree=sreh2_value('SU_UPLOAD_MINFREE',,host_nickname)
upload_log=sreh2_value('SU_UPLOAD_LOG',,host_nickname)
webmaster=sreh2_value('SU_WEBMASTER',,host_nickname)
verbose=sreh2_value('SU_VERBOSE',,host_nickname)  /* use sre_util specific verbosity */
seperator='!===============1x2y3z4a5b6c7d8e9f0g9h8i7j6k5l4m3n2o1===========!'


xisreset=0
select
   when which_util='PUT_FILE' then call do_put_file
   when which_util='GET_URL' then call do_get_url
   when which_util='SENDFILE' | which_util='SEND_FILE' then call do_sendfile
   when which_util='MESSAGE' then call do_message
   when which_util="SRE_UTIL" then xisreset=1          /* might be a reset */
   otherwise do
/* later, default is the sre_util.cfg configurator */
      rcode=sre_command('STRING Unknown SRE_UTIL command: 'which_util,,id_info)
   end 
end

if xisreset=0 then return rcode

/* reset? */
opts.=''
crlf='0d0a'x
do until list=''
   parse var list opt1 '&' list
   parse var opt1 avar '=' aval
   avar=sre_packur(avar)
   vv='!'||strip(translate(avar))
   opts.vv=strip(sre_packur(translate(aval,' ','+'||'0d0a09'x)))
   opts.0=opts.0||' '||vv
end
if opts.!RESET=1 then do
   call cfg_util
   if rcode='' then do
     rcode=sreh2_sre_util_cfg(host_nickname)
    if rcode<>1 then return rcode
   end
   rcode=sre_command('STRING SRE_util parameters have been reset.',,id_info)
end
rcode=sre_command('STRING An unknown SRE_UTIL mode. ',,id_info)

return rcode



/******************************************************************/
/* FILE UPLOADER--- Requires that the client's browser has the 
  html 3.0 capability of using the type=text attribute in a 
  FORM INPUT element. (i.e. Netscape 2.01)
 
  Note:
  Typical mozilla request header:
Content-type: multipart/form-data; boundary=---------------------------53152890216706
*/
/******************************************************************/

do_put_file:


crlf='0d0a'x
rept=''
usefile=''

/*get content type request header */
aa=sre_reqfield('content-type content-length')
parse var aa atype '01'x atype2

/*atype="multipart/form-data; boundary=---------------------------309151678928465"*/

/* is there a content-type request header ? */
if atype="" then do
    rcode=upload_status("0 , No <tt> content-type </tt> request header")
    return 1
end

parse var atype thetype ";" boog 'boundary=' abound0    /* get the type */

abound="--"||strip(abound0)  /* since boundaries always start with -- */

/*
rcode=sre_command('var type text/plain ',list||'0d0a0d0a'x||'Abound0 '||'0d0a'x||'|'||abound0||'|',id_info)
return 1 
*/

if translate(thetype)<>"MULTIPART/FORM-DATA" then do
   rcode=upload_status("0 , No <tt> multipart/form-data </tt> in Content-type ")
   return 1
end

if abound="" then do
   rcode=upload_status( "0 , No boundary ")
   return 1
end

adri=filespec('D',upload_dir)
tmp1=sysdriveinfo(adri)
spacefree=word(tmp1,2)

if atype2<>"" then do
   parse var atype2 ":" clen
   if datatype(clen)='NUM' then  do   /* check space constraints */
     if clen> (upload_maxsize*1000) then do
         rcode=upload_status('0, File ('||clen||'bytes) exceeds maximum allowable size ('||upload_maxsize||'K)')
         return 1
     end
     if clen> (spacefree-(1000*upload_minfree)) then do
         down_okay=0
         rcode=upload_status("0, Not enough disk space available. ")
         return 1
     end
  end
end

/* basic status okay. So pull out stuff */

abody=list

abd1=crlf||abound
abd2=abound


/* loop through message, pulling out blocks and storing in stem var bigstuff. */

/* we have parsed the blocks..
  There are 3 types of header info (in ablock.var.i.j)
       Content-Type: mime type; if missing assume text/plain
       name: the variable name (standard form stuff)
      filename: name of local file (added by browser, on type=file elements)

  Not retained:       Content-Disposition:  should be form-data
*/


parse var abody foo1 (abd2) abody    /* move beyond first boundary and it's crlf */

/* check for netscape 2.0 incorrect format */
if pos(abound,abody)=0 then do   /* no ending boundary, so add one */
   abody=abody||crlf||abound||" -- "
end

mm=0
do until abody=""

  if mm>0 then do
    if abbrev(abody,'--')=1 then leave        /* -- signals no more */
 end

 parse var abody . (crlf) thestuff (abd1) abody        /* get a  boundary defined block */


  mm=mm+1
  ablock.!varname.mm=0 ; ablock.!filename.mm=0
  ablock.!ct.mm=0

  do forever            /* get block headers.  Stop when hit a blank line */
     parse var thestuff anarg (crlf) thestuff

     if anarg="" then do                /* empty line means "end of headers */
           leave
     end
     else do                    /* extract the arguments on this line */
         do until anarg=""
              parse var anarg anarg1 ";" anarg
              boob1=pos(':',anarg1) ; boob2=pos('=',anarg1)
              if boob1=0 then nixon=boob2
              if boob2=0 then nixon=boob1
              if boob1>0 & boob2>0 then nixon=min(boob1,boob2)
              t1=translate(strip(strip(substr(anarg1,1,nixon-1)),,'"'))
              t2=strip(strip(substr(anarg1,nixon+1)),,'"')
              if t1="NAME" then ablock.!varname.mm=translate(t2)          /* name of this block */
              if t1="FILENAME" then ablock.!filename.mm=t2   /* original file name */
              if t1="CONTENT-TYPE" then ablock.!ct.mm=t2        /* content type */
/* don't bother storing content-disposition */
          end     /* exract arguments */
     end        /* extract args on this line */
  end                    /* get a line */
  if thestuff<>"" then do               /* what remains is the contents of the record */
    ablock.!body.mm=thestuff
  end
  else do
     ablock.!body.mm=""
  end

end

nblocks=mm

if nblocks=0 then do
     rcode=upload_status( " 0 , no data recieved ")
     return 1
end


/* this seperate this report from prior reports */
rept=' '||crlf
rept=rept||'Date: '||date()|| " " ||time()||crlf
rept=rept||'From:'|| client_ip||crlf

/* look for non 0 .filename. */

jwritten=0

do jj=1 to nblocks
   if ablock.!body.jj="" then iterate /* empty block */
   if ablock.!filename.jj<>0     then do   /* got a file block */
      origfile=ablock.!filename.jj
      amatch=jj
      namekey=ablock.!varname.jj    /* the name of this block */
      tryname="FILE????.UPL"
      ctval=ablock.!ct.jj
      do ll=1 to nblocks                /* see if another block, with same name */
          if ll=amatch then iterate         /* don't check self */
          if ablock.!varname.ll=namekey then do    /* this is the naming bar */
                posname=strip(translate(ablock.!body.ll,' ','0d0a09'x))
                if posname<>'' then do
                     tryname=posname /* ignore if empty */
                end

                ablock.!varname.ll=0     /* don't need anymore */
                ablock.!varname.amatch=0  /* so zap it, thereby avoiding future matches */
                leave
          end
      end        /* scan for match */

    tryname=strip(tryname)

/* tryname is either a default name, or one suggested in the form 
   upload_allowed sets USEFILE (a fully qualified file name)
   If an error occurs, RCOCE<>'' (a response will have been sent */

   clen=length(ablock.!body.amatch)
   fpo=upload_allowed(tryname,clen)

   if rcode<>'' then return 1

/* it fits! */
    foo=stream(usefile,'c','open write')
    foo=charout(usefile,ablock.!body.amatch,1)  /* so write it */
    if foo<>0 then do
      foo=stream(usefile,'c','close')
      rcode= upload_status(" 0 , could not write "|| tryname)
      return 1
    end
    foo=stream(usefile,'c','close')
    jwritten=jwritten+1
/* else, write message to upload_log */

   if VERBOSE>0 then call sre_pmprintf( " Uploaded: " usefile)
    rept=rept||'; -- '||crlf
    if jwritten>1 then do
       rept=rept||'NewFile #'||jwritten||': '||usefile||'; length ='||clen||crlf
    end
    else do
       rept=rept||'NewFile: '||usefile||'; length ='||clen||crlf
    end
    rept=rept||'ClientSide_Name:'||origfile||crlf        
    if ctval<>0 then  rept=rept||'Content-Type: '||ctval||crlf
   end   /* got a filename block */
end                     /* look for a filename block */

/* write generic comments */
cmtwrite=0
do mm=1 to nblocks      /* look for misc comments */
  if ablock.!varname.mm<>0 & ablock.!filename.mm=0 then do
    if ablock.!varname.mm<>'' then do
       if cmtwrite=0 then rept=rept||'; -- '||crlf
       cmtwrite=1
       ook=translate(ablock.!body.mm,' ','0d0a09'x)
       rept=rept||ablock.!varname.mm ||": "||ook||crlf
    end
  end
end

if rept<>"" then foo=write_uplog(upload_log,rept)

return upload_status(" 1  , Upload completed as  "||usefile)



/****************/
/* is upload allowed
args are the selector (to map to a fully qualified file)
         its size   
Optionally, a 3rd argument = 1 means "just check size", in which case the
            first argument must be a fully qualified filename
*/

upload_allowed:procedure expose rcode host_nickname id_info upload_dir usefile ,
                        upload_maxsize upload_minfree rept upload_log host_nickname
parse arg checksel,clen,sizeonly


if sizeonly=1 then do
   usefile=checksel
   signal on_sizeonly
end 

/* check various put permissions, virtual directories,  etc */

/* checksel must NOT be fully qualified file (it MUST be relative; either to
   upload directory or to a virtual directory */
if pos(':',checksel)>0 then do
   rcode=upload_status('0 , Fully qualified destination file not permitted (use relative name)')
   return 1
end

attribs=sreh2_get_attributes(host_nickname,checksel,,id_info)
parse var attribs ,
          realm   '01'x  rule '01'x redirect '01'x . '01'x . '01'x ,   
          permissions  '01'x  .  
permissions=space(translate(permissions))
parse var redirect redirect_type redirect_to
redirect_type=strip(translate(redirect_type))
avirt=''
if redirect_type='DIR' then avirt=redirect_to                   

usefile=sreh2_fig_file_name(HOST_NICKname,upload_dir,checksel,avirt,rule,'!UPLOAD')

/* If this is NOT in the upload_dir, check for PUT permission */
if abbrev(translate(usefile),translate(upload_dir))=0 then do
   if wordpos('PUT',permissions)=0 then do
     rcode=upload_status("0, No PUT permission. ")
     return 1
   end 
end

/* if ? in file, then try making a temporary file */
if pos('?',usefile)>0 then do
   usefile=sre_tempfile(usefile)
end

/* error if it exists */
if usefile='' then do
   rcode=upload_status(" 0 , can not create new file ")
   return 1
end

foo=stream(usefile,'c','query exists')
if foo<>"" then do
   rcode=upload_status(" 0 , can not overwrite file: ")
   return 1
end

/* error if no such directory */
poo=lastpos('\',usefile);poo2=left(usefile,poo-1)
poo=dosisdir(poo2)
if poo=0 then do
   rcode=upload_status(' 0 ,  No such directory '||poo2)
   return 1
end

on_sizeonly:      nop                    /* jump here if sizeonly check */

/* will it fit? */
if clen> (upload_maxsize*1000) then do
   rcode=upload_status('0, File (with '||clen||' bytes) exceeds maximum allowable size ('||upload_maxsize||'K)')
   return 1
end
adri=filespec('D',usefile)
tmp1=sysdriveinfo(adri)
spacefree=word(tmp1,2)
if clen > (spacefree-(1000*upload_minfree)) then do
    rcode=upload_status("0, Not enough disk space available. ")
    return 1
end

return 0


/***********************************************************/
/* Write record to upload log */
/********************************************************/
write_uplog: procedure expose verbose  host_nickname
parse arg uplog,rept
astat=sre_append_file(uplog,rept,2,1)
if abbrev(astat,'-')=1 then 
   foo=sre_write_error('SRE_UTILS write uplog error: 'astat,,1)
return 0


/******************************************************/
/* Used by put_file and get_url    */
/******************************************************/
upload_status:procedure expose id_info jwritten rept upload_log usefile  host_nickname
parse arg amess
parse var amess ok ',' amess ;ok=strip(ok)

if ok=0 then do
   rept=rept||'; '||usefile||'0d0a'x||'; -- Error: 'amess
   foo=write_uplog(upload_log,rept)
end 

if ok=0 then do
    doc = '<!doctype html public "-//IETF//DTD HTML 2.0//EN"> <html><head><title>'
    doc=doc||" Unsuccessful upload </title></head><body> "
    doc=doc||" File could not be uploaded.  <p> <b> Error: </b>"||amess
    doc=doc||"</body></html>"
    foo=sre_command('var type text/html',doc,id_info) 
end
else do
    doc = '<!doctype html public "-//IETF//DTD HTML 2.0//EN"> <html><head><title>'
    doc=doc||" Successful upload </title></head><body> "
    doc=doc||' Successful upload:<tt>'||amess||'</tt> <hr width="50%">'
    doc=doc||'<a href="upload.htm">Another upload?</a>'
    doc=doc||"</body></html>"

    foo=sre_command('var type text/html',doc,id_info) 
end
return foo


/* ----------------------------------------------------------- */
/* Upload a remote url to a local file (routine, uses many globals) */
/* ----------------------------------------------------------- */
do_get_url:

rcode=''

crlf='0d0a'x
rept=' '||crlf
rept=rept||'Date: '||date()|| " " ||time()||crlf
rept=rept||'From:'|| client_ip||crlf

opts.=''
crlf='0d0a'x
do until list=''
   parse var list opt1 '&' list
   parse var opt1 avar '=' aval
   avar=sre_packur(avar)
   vv='!'||strip(translate(avar))
   opts.vv=strip(sre_packur(translate(aval,' ','+'||'0d0a09'x)))
   opts.0=opts.0||' '||vv
end

if opts.!FILE='' then
  tryname="FILE????.UPL"
else
  tryname=strip(opts.!FILE)

/* where will this be written to.. */
/* tryname is either a default name, or one suggested in the form 
   upload_allowed sets USEFILE (a fully qualified file name)
   If an error occurs, RCODE<>'' (a response will have been sent */

clen=0                  /* check size later */
fpo=upload_allowed(tryname,clen)
if rcode<>'' then return 1

/* parse server name and request out of geturl */
geturl=opts.!URL
if geturl='' then do
   rcode=upload_status("0 , No URL specified ")
   return 1
end

parse var geturl t1 '//' server '/' request
if translate(T1)<>"HTTP:" then do
   isbad=' <p> Sorry, the URL to upload is misspecified:'||geturl
   signal nogeturl
end

/* now get the url.  Use SRE_GET_URL_ADV */

adri=filespec('D',upload_dir)
tmp1=sysdriveinfo(adri)
spacefree=word(tmp1,2)
maxlen=min(upload_maxsize*1000,(spacefree-(1000*upload_minfree)) )

/*
 stuff=sre_get_url_adv(maxtime,maxsize,type,server,req,mehost,upwd,mhdrs, ,
                       verbose,qs,trn_Id,sock_time)          */

stuff=sre_get_url_adv(30,maxlen/1000,'GET',server,'/'||request,'sre2003@'||server, ,
                      opts.!USERNAME||' '||opts.!PASSWORD,,0)
parse var stuff astat . '0d0a'x stuff
astat=strip(astat)

if astat<>0 then do
  serrs.1 = 'ioctl error'
  serrs.2 = 'connection error'
  serrs.3 = 'problem encountered in sockrecv'
  serrs.4 = 'sockgethostbyname error'
  serrs.5 = 'coding error in this procedure'
  serrs.6 = 'too many characters to send '
  rcode=upload_status("0 , "||serrs.astat||' ( '||opts.!URL||')')
  return 1
end

/* parse out headers */
ctype=''
do until stuff= ''
   parse var stuff aline '0d0a'x stuff
   if aline ='' then leave
   parse var aline a1 ':' a2
   a1=strip(translate(a1))
   if a1='CONTENT-TYPE' then ctype=a2
end 

foo=stream(usefile,'c','open write')
foo=charout(usefile,stuff,1)  /* so write it */
if foo<>0 then do
   foo=stream(usefile,'c','close')
   rcode= upload_status(" 0 , could not write "|| tryname)
   return 1
end
foo=stream(usefile,'c','close')

/* else, write message to upload_log */

if VERBOSE>0 then call sre_pmprintf( " Uploaded: " usefile)
rept=rept||'; -- '||crlf
rept=rept||'NewFile: '||usefile||'; length ='||length(stuff)||crlf
rept=rept||'URL:'||opts.!URL||crlf        
if ctype<>0 then  rept=rept||'Content-Type: '||ctype||crlf


avv=opts.0
cmt=0
do until avv=''
   parse var avv a1 avv ; a1=strip(a1)
   if wordpos(a1,'!FILE !URL !USERNAME !PASSWORD')>0 then iterate
   rept=rept||substr(a1,2)||' = '||opts.a1||crlf
    if cmt=0 then do
       rept=rept||';-- '||crlf
       cmt=1
    end 
end

if rept<>"" then foo=write_uplog(upload_log,rept)

rcode=upload_status(" 1  , Upload completed as  "||usefile)
return 1



/* ********************************  */
/* Send a file, with a variety of options.
   This includes recording succesful transfer of a file, 
   after you know it's been recieved --
    perhaps disallow it if user list specified */
do_sendfile:

crlf='0d0a'x
opts.=''
opts.!FILE.0=0
logit=0

do until list=''
   parse var list opt1 '&' list
   if pos('=',opt1)=0 then do
        aval=opt1 ; avar='FILE'
   end 
   else do
     parse var opt1 avar '=' aval
    end
   avar=strip(Translate(sre_packur(avar)))
   aval=sre_packur(translate(aval,' ','+'||'09'x))
   if aval='' then iterate

   if abbrev(avar,'FORCE')=1 then avar='FORCE'
   if avar='PAUSE' then do
        avar='FILE'
        aval=':'||strip(aval)
   end 
   if avar='HEADER' then avar='HEADERS'

   if avar='LOG' then do
      if strip(aval)='0' then  logit=0 
      if aval='0' then  logit=0 
      if strip(aval)='1' | strip(aval)='' then  logit=1 
   end

   vv='!'||avar
   
   if vv='!FILE' then do
     if strip(aval)='' then iterate     /* no file specified, so ignore */
     kka=opts.vv.0+1
     opts.vv.kka=strip(aval)
     opts.vv.0=kka
   end
   else do
     opts.vv=strip(aval)
   end

   opts.0=opts.0||' '||vv
end

/* expect: FILE (or several FILE) HEADER FORCE NOCHECK NOWAIT 
           PAUSE nnn (or several PAUSE nnn) */

cprotocol=sre_extract('clientprotocol')

if opts.!FILE.0>1 & opts.!NOCHECK<>1  then do    /* if multiple files, can client handle it ? */
    parse upper var cprotocol 'HTTP/' ver .     /* you can suppress this check with a NOCHECK option */
    if datatype(ver)<>'NUM' then ver=0.9
    reqconn=translate(sre_reqfield('connection'))
    cando=1       
    if ver<1.1 then do
       doma=pos('KEEP-ALIVE',reqconn)+pos('MAINTAIN',reqconn)
       if doma=0 then cando=0 /* old browser -- don't send additional files */
    end
    if cando=0 then do
      rcode=send_status('0 , Client can not be sent multiple files')
      return 1
    end
end

ithf=0


/* if any of the  files can not be found, send none */
do jthfile=1 to opts.!FILE.0
  afile=opts.!FILE.jthfile

  if abbrev(afile,':')=1 then do
     ithf=ithf+1
     usefiles.ithf=afile
     iterate
  end

  attribs=sreh2_get_attributes(host_nickname,afile,,id_info)
  parse var attribs ,
          realm   '01'x  rule '01'x redirect '01'x . '01'x . '01'x ,   
          permissions  '01'x  requires   '01'x .

/* check for requires */
  iok=sreh2_privs_check(requires,privset)
  if iok=0 then do
     rcode=send_status('0 , Insufficient privileges for: '||afile)
     return 1
  end

  parse var redirect redirect_type redirect_to
  redirect_type=strip(translate(redirect_type))
  avirt=''
  if redirect_type='DIR' then avirt=redirect_to 
  ddir=sre_datadir()                  
  usefile=sreh2_fig_file_name(HOST_NICKname,ddir,afile,avirt,rule,'HTML')
  if stream(usefile,'c','query exists')='' then do
     rcode=send_status('0 , Could not find a file for: '||afile)
     return 1
  end
  ithf=ithf+1


/* check htaccess? */
  htaccess=sreh2_value('HTACCESS',,host_nickname)
  htaccess=strip(htaccess)
  if htaccess<>-1 then do
     if wordpos('NO_HTACCESS',permissions)>0 then htaccess=0
     if wordpos('HTACCESS',permissions)>0 then htaccess=1
  end
  if wordpos(htaccess,'0 1')=0 then htaccess=0
  call do_htaccess
  if rcode<>'' then  return 1

  usefiles.ithf=usefile         /* physical file */
  usesels.ithf=afile            /* selector pointing to usefile */
end

usefiles.0=ithf

if opts.!HEADERS<>'' then do
     hdrsnew=''
     hdrs=strip(opts.!HEADERS)
     do until hdrs=''
        parse var hdrs ah '0d0a'x hdrs
        if ah='' then iterate
        if hdrsnew='' then
           hdrsnew=ah
        else
           hdrsnew=hdrsnew||'0d0a'x||ah
     end
     foo=sre_command('Header add '||hdrsnew,,id_info)
end 

totsent=0
nowait=''
if opts.!NOWAIT=1 then nowait='NOWAIT '
do jj=1 to usefiles.0
  if abbrev(usefiles.jj,':')=1 then do  /* this is a "PAUSE" */
      parse var usefiles.jj . ":" apause .
      apause=strip(apause)
      if datatype(apause)='NUM' then do
         foo=sre_syssleep(apause)
      end 
      iterate
  end
 
  fii=sendfile(jj,usefiles.0,usefiles.jj,usesels.jj,opts.!FORCE,nowait)
  if abbrev(fii,'ERROR')=1 then do
    rcode=send_status('0 , Error sending: '||subword(fii,2))
    return 1
  end

/* successful send of file (as specified by a selector) -- augment in SENDFILE.CNT */
   aasel0=translate(usesels.jj,'+',' ')
   aafile0=usefiles.jj
   aasel=sre_fix_url(aasel0,translate(servername))
   foo=sre_cache_data('SENDFILE','MODIFY INC WRITE ADD ',aasel,'SENDFILE',1)
   parse var foo afoo .
   if length(afoo)=1 then  /* error code */
      if foo<>0 then call sre_write_error('Problem writing to SENDFILE counter: 'foo)

/* write fuller record to sendfile-log-file? */
/* HOST SEL CLIENT TIME BYTES */
   if logit=1 then do
      anid=sreh2_current_second()||'_'||reqnum
      foo=sre_cache_data('SEND_LOG','ADD WRITE ',anid, ,
          host_nickname,aasel0||' / '||aafile0,client_ip,date('n')||' '||time('n'),lenstuff)
      parse var foo afoo .
      if length(afoo)=1 then  /* error code */
         if foo<>0 then call sre_write_error('Problem writing to SENDFILE log: 'foo)

   end

  totsent=totsent+lenstuff
end 
vvv=sre_extract('bytessent')
rcode='200 '||vv

return 1


/*************/
/* check htaccess file    */

do_htaccess:

/* usefile: physical file */
/* afile : selector pointing to usefile */

rcode=''
if htaccess<>1 then return 1  /* do not check */

hfile=sre_value('HTACCESS_FILE',,'SRE')
if hfile='' then return 1  /* do not check */

authh=sre_reqfield('Authorization')
rr=sreh2_check_htaccess(usefile,authh,hfile,afile)

parse var rr rrstat ',' rrinfo ; 
rrinfo=strip(rrinfo); rrstat=strip(rrstat)
select 
  when rrstat=0 | rrstat=1 | rrstat=9 then return 1      /* 0 used to just get index file */
  when  rrstat=3 then do  /* redirect */
     port=sre_extract('serverport')
     rcode=sre_move_response(301,rrinfo,servername,port,,afile)
  end
  when rrstat=4 then do  /* auth */
     if wordpos('SUPERUSER',translate(privset))>0 then return 1  /* ignore if superuser */
     therealm=rrinfo
     amess='Your username is not recognized. For this resource: '||,
               '<br><tt>'afile'</tt><br>SendFile requires user specific access privileges'
     
     if aiter='' then
         rcode='PRIVS  'amess
     else
         rcode= 'AUTH '||amess
     return 1
     
  end
  when rrstat=5 then do            /* error */
     if wordpos('SUPERUSER',translate(privset))>0 then return 1  /* ignore if superuser */
     rcode=sre_error_response('403',,servername,rrinfo,id_info)
  end
  otherwise nop
end

return 1


/************************************/
/* SENDFILE:
   This uses sreh2_multi_send to send a file 1k at a time.
   It also starts and closes multipart sends (of several
   seperate files)
*/
sendfile:procedure expose host_nickname id_info cprotocol lenstuff  host_nickname
parse arg kat,k0,aff,asel,ftext,fwait

select
 when ftext=1 | abbrev(translate(ftext),'TEXT')=1 then do
    mtype='text/plain'
    ftext=1
 end
 when ftext=2 | abbrev(translate(ftext),'BIN')=1 then do
    mtype='application/octet-stream'
    ftext=2
 end
 otherwise do
    mtype=sreh2_get_mimetype(asel,host_nickname)
 end
end

lenstuff=0
if ftext=1 then
 stuff=sre_read_file(aff,3,3,1)
else
  stuff=sre_read_file(aff,3,3,0)

if stuff='' then return 'ERROR unable to read file for '||asel

lenstuff=length(stuff)

padd='A'
select
 when k0=1 then do
    p1=''; p2='1S' ; p3='1E' ; padd='1A'
 end 
 when kat=1 then do                /* part 1 */
    p1='S' ; p2='SS' ; p3='SE'
 end 
 when kat=k0 then do                /* part final */
    p1='E' ; p2='ES' ; p3='EE'
 end 
 otherwise do                           /*middle part */
    p1='M' ; p2='MS' ; p3='ME'
 end
end

mhdr=''
if ftext=2 then do
   goo=translate(asel,' ','\/')
   if goo<>'' then do
      zname=strip(word(goo,words(goo)))
      mhdr='Content-Disposition: attachment; filename="'||zname||'"'
   end
end

j2=min(1000,lenstuff)
if j2=lenstuff then do             /* small first part */
   if p1='' then do             /* short 1 part is special */
     rcode=sre_command('VAR type '||mtype,stuff,id_info,,mhdr)
     return rcode
   end
   foo=SREH2_multi_send(left(stuff,j2),fwait||" "||mtype,p1,,,mhdr,id_info,cprotocol)
   return foo
end


/* if here, a multiple piece part */

apoo=left(stuff,j2)
foo=SREH2_multi_send(apoo,fwait||" "||mtype,p2,,,mhdr,id_info,cprotocol)
didsnd=length(apoo)

if foo<>'' then return foo

j1=j2+1
j2=min(j1+999,lenstuff)
do until j2=lenstuff
     jtot=(1+j2)-j1
     apoo=substr(stuff,j1,jtot)
     foo=SREH2_multi_send(apoo,,padd,,,mhdr,id_info,cprotocol)
    didsnd=didsnd+length(apoo)
     if foo<>'' then return foo
     j1=j2+1
     j2=min(j1+999,lenstuff)
 end 

jtot=(j2+1)-j1

apoo=substr(stuff,j1,jtot)
foo=SREH2_multi_send(apoo,,p3,,,mhdr,id_info,cprotocol)
didsnd=didsnd+length(apoo)

return foo



/******************************************************/
/* Used by send_file    */
/******************************************************/
send_status:procedure expose id_info rept upload_log usefile  host_nickname
parse arg amess
parse var amess ok ',' amess ;ok=strip(ok)

if ok=0 then do
    doc = '<!doctype html public "-//IETF//DTD HTML 2.0//EN"> <html><head><title>'
    doc=doc||" Unsuccessful send </title></head><body> "
    doc=doc||" SendFile: File could not be sent.  <p> <b> Error: </b>"||amess
    doc=doc||"</body></html>"
    foo=sre_command('var type text/html',doc,id_info) 
end
else do
    doc = '<!doctype html public "-//IETF//DTD HTML 2.0//EN"> <html><head><title>'
    doc=doc||" Successful send </title></head><body> "
    doc=doc||' Successful send:<tt>'||amess||'</tt> <hr width="50%">'
    doc=doc||'<a href="upload.htm">Another file-send?</a>'
    doc=doc||"</body></html>"

    foo=sre_command('var type text/html',doc,id_info) 
end
return foo



                /************************************************/
/* --------------------------MESSAGE BOX UTILITIES ---------------------------------*/
/* The following is a set of message box utilities.  */

The follow modes are supported:
     MESSAGE
          the "write to message box" procedure

    ASK
         Display an OPTION list of available message boxes; client
         then selects which one to view.

    VIEW        View a particular message box
*/
do_message:

ll=list
opts.=''
do until ll=''
    parse var ll a1 '&' ll
    parse var a1 avar '=' aval
    avar=space(avar,0)
    aval=strip(sre_packur(translate(aval,' ','+')))
    vv='!'||translate(avar)
    opts.vv=aval
    opts.0=opts.0||' '||avar
end 
messbox_dir=sreh2_value('SU_MESSBOX_DIR',,host_nickname)

/*** Put message in a message box (or broadcast a message) */
if abbrev(translate(opts.!MODE),"MESS")=1 then do
   a1=domessage()                       
   parse var a1 astat ',' amessage

   select
     when  astat=-2 then do          /* authorization problem */
       rcode='AUTH '||amessage
       if aiter='' then rcode='PRIVS '||amessage
       return 1
     end
     when astat=-1 then do          /* error */
        call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
        call lineout tempfile, "<html><head><title>Problem delivering message</title></head>"
        call lineout tempfile, "<body>"
        call lineout tempfile, "<h3>Problem delivering message </h3>"
        call lineout tempfile, amessage
        call lineout tempfile, "<hr></body></html>"
        call lineout tempfile
        rcode=sre_command('FILE type text/html erase name 'tempfile,,id_info)
        if verbose>1 then call sre_pmprintf(' Message box error: 'amessage)
      end
      when astat=0  then do           /* succes message */
         call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
         call lineout tempfile, "<html><head><title>Message Delivered</title></head>"
         call lineout tempfile, "<body>"
         call lineout tempfile, "<h3>Message Delivered.</h3>"
         call lineout tempfile, amessage
         call lineout tempfile, '<hr><a href="javascript:history.go(-1)">Back.. </a>'
         call lineout tempfile,"</body></html>"
         call lineout tempfile
         rcode=sre_command('FILE type text/html erase name 'tempfile,,id_info)
         if verbose>2 then call sre_pmprintf(' Message accepted: 'amessage)
      end
      otherwise do               /* okay, with response file */
        rcode =sre_move_response(302,strip(amessage),servername)
        if verbose>2 then call sre_pmprintf(' Message accepted')
      end               /* otherwise */
   end          /* select */
   return rcode
end

if abbrev(translate(opts.!MODE),"VIEW")=1 then do
   rcode=viewmessage()
   if abbrev(rcode,'-2,')=1 then do             /* privileges needed */
       parse var rcode . ','amessage
       rcode='AUTH '||amessage
       if aiter='' then rcode='PRIVS '||amessage
       return 1
   end
   return rcode
end

if abbrev(translate(opts.!MODE),"ASK")=1 then do
  rcode=what_messbox()
  return rcode
end

/* if here, error */
rcode=sre_command('string SRE_UTIL: Unknown message-box mode: '||mode,,id_info)
return 1


/* ----------------------------------------------------------------------- 
DOMESSAGE: Places a message in a message box, or in the mail directory.

This procedure returns:
   status, message

status:  
   -2 : unauthorized (AUTH or PRIVS return to srehttp2 will happen
   -1 : return an error message
    0 : return a success message
    1 : message is a response file (send the contents of this response file)


An example of output to message box file (not including the start and end lines):
------- start
(seperator line)
Date: Wed, 04 Sep 96 23:43:17 +0600
From: user@universe.planet.net
E-mail:bob@farm.iowa.net
Password:295181
Field1: sadfasfd
Field2: 1241414
Content-Length: 43
Subject: What's the story

This is a very funny thing.
Keep it up!
----- end 

Notes:
  * The (seperator line) is a goofy string used to signal the start of a message.

  * if write_to_file=1, then instead of writing to the message box file,
    a seperate file is created in the mail directory.  
    This file uses the
          From:, To:, Subject:,  and  Date:
    fields used as "headers".
    The Contents: file is used as the file's "body" (seperated 
    from the headers by an empty line)

  * A "password" field can be included (in messages written to
    a messagebox file). It is (weakly) encrypted using
    the the MESSAGE_SCRAMBLE SRE_UTIL.CFG variable

----------------------------------------------------------------------- */

domessage: procedure expose  messbox_dir verbose  opts. client_ip ,
                            uri seperator servername privset  id_info  host_nickname

crlf='0d0a'x
write_to_file=0
broadcast_list=' ' ; broadcast_only=0
fromval=' ' ; toval=' '; subjectval=' '; emailval=' '
if opts.!QUERY_FILE=0 then opts.!QUERY_FILE=''

reflist='!SUBJECT !CONTENT !BROADCAST_ONLY !BROADCAST_NAME !BROADCAST_LIST ',
        '!EMAIL !ADDRESS !PHONE !FAX !PASSWORD !RESPONSE_FILE ',
        '!WRITE_TO_FILE !MESSBOX !NAME !FROM !MODE '

/* Look for the destination  message box.
   If none found, put message in default (messages.log) area */

gotbox=opts.!MESSBOX
if gotbox='' then gotbox='MESSAGES'

if wordpos(strip(translate(opts.!WRITE_TO_FILE)),'YES Y 1')>0 then write_to_file=1

/* Is this NOT one of the "open access" message boxes?
   Then check to see if client has access rights to this message box */

opens=translate(sreh2_value('SU_OPEN_MESSBOX',,host_nickname))
okay=0
if wordpos('*',OPENS)>0 | wordpos(translate(gotbox),opens)>0 then do
  okay=1
end 
else do
  tprivset=translate(privset)
  if wordpos('SUPERUSER',tprivset)>0 then do
      okay=1
  end 
  else do
    do iu=1 to words(privset)
      aww=word(privset,iu)
      if abbrev(aww,'MESSBOX:')=0 & abbrev(aww,'MESSBOX=')=0 then iterate
/* a messagebox privilege -- does it match this messagebox ? */
      AWW=SUBSTR(AWW,9)               /*DROP MESSBOX= prefix*/
      OKAY=sre_wild_match(gotbox,AWW)
      if okay<>0 then leave
    end
  END
end

if okay=0 then return '-2,You do not have access privileges for the '||gotbox||' Message Box '

/* check for, or initialize, message box file */
lfile=messbox_dir||"\"||gotbox||".LOG"
foo=stream(lfile,'c','query exists')
if foo=' ' then do              /* does not exist: so initialize it */
   call lineout lfile,'SREhttp/2 message-box file for: ' gotbox
   call lineout lfile,' '
   call lineout lfile
end

msize=stream(lfile,'c','query size')
if msize=' ' then return '-1,No such message box:' gotbox             /* nope */

/* buildme is the message that will be saved, including headers */
buildme=crlf||seperator||crlf

/* create unique message id */
 p1=date('s')
 p2=time('n') ; p2=delstr(p2,3,1); p2=delstr(p2,5,1)
 p3=sre_extract('serverport')
 p4=sre_extract('transaction')
 p5=space(translate(client_ip,' ','.'),0)

 message_id=c2x(stringcrc(p1||p2||p3||p4))||right(p5,4)
 subj15=strip(translate(opts.!subject))
 if abbrev(subj15,'REPLY TO:')=1 then parse var subj15 . ':' subj15
 subj15=strip(left(translate(subj15,'_',' '),15,' '))
 message_id=subj15||'$'||message_id

buildme=buildme||'Message-id: ' message_id||crlf
tm1=time("n") ; tm2=date("n")
buildme=buildme||"Date: "||tm1||' '||tm2||crlf

if write_to_file==1 then do
  gmtoff=sre_gmtoffset()              /* use this if write_to_file is on */
  if datatype(gmtoff)="NUM" then
     gmtoff=gmtoff/36 
  else
      gmtoff=' '
  dayname=left(date('w'),3)
  dateval=dayname||', '||tm2||' '||tm1||' '||gmtoff
end
/* typical e-mail date format= Date: Sat, 19 Oct 96 08:28:09 -0700*/

response_file=opts.!RESPONSE_FILE

/* pull out various elements */

fromval=''
if opts.!NAME='' then opts.!name='No name given'
if opts.!NAME<>'' then do
   fromval='From: '||opts.!NAME
   buildme=buildme||fromval||crlf
   zfrom=fromval
end

if opts.!PASSWORD<>'' then do
  boop=sreh2_value('SU_MESSAGE_SCRAMBLE',,host_nickname)
  if boop=' ' then boop=1234
  t1=space(translate(elems.goo.val),0)
  if t1<>' ' then do   /* empty password is ignored */
    do mm=1 to length(t1)
       achar=substr(t1,mm,1)
       achar=c2d(achar)
       boop=(boop*achar)//1000000
    end
    buildme=buildme||'Password: ' boop||crlf
  end
end

emailval=''
if opts.!EMAIL<>'' then do 
   emailval='E-mail: '||opts.!EMAIL
   buildme=buildme||emailval||crlf
end

gob='Address Phone Fax'
do until gob=''
   parse var gob aww gob ; 
   vv='!'||translate(strip(aww))
   if opts.vv<>'' then buildme=buildme||strip(aww)||': '||opts.vv||crlf
end 

if opts.!Subject='' then
  opts.!subject='No subject'
asubject='Subject: '||opts.!SUBJECT


/* is this a request to "broadcast" this message (rather then, or in addtion to,
  storing it locally? */

broadcast_list=opts.!BROADCAST_LIST

if broadcast_list<>'' then do
/* CHECK FOR PRIVS, If none, ask for authorization */
    wow1=wordpos('BROADCAST',upper(privset))
    wow2=wordpos('SUPERUSER',upper(privset))
    wow3=wordpos(upper(broadcast_list),upper(privset))
    if wow1+wow2+wow3=0 then do
       return '-2,Not allowed to broadcast  to  ' broadcast_list
    end

/* check size */
    mailmax=sreh2_value('SU_MAIL_MAXSIZE',,host_nickname)
    if length(opts.!CONTENT)>(1000*mailmax) then 
       return '-1,Size of message exceeds maximum of 'mailmax'K '

/* check for existence of broadcast_list file */
    amaildir=sreh2_value('SU_MAIL_DIR',,host_nickname)  /* which directory to write to? */
    ylfile=amaildir||"\"||broadcast_list
    if stream(ylfile,'c','query exists')=' ' then 
        return  '-1,Unable to find e-mail-broadcast list: ' oadcast_list

   foo=opts.!BROADCAST_ONLY
   if wordpos(foo,'YES Y 1')>0 then broadcast_only=1
   broadcast_name=opts.!BROADCAST_NAME

end

/* now write the message locally */
select
  when broadcast_only=1 then do
        nop                             /* do NOT store contents of message locally */
  end 

  when write_to_file<>1 then do             /* write to messagebox file */ ;

    do igoo=1 to words(opts.0)            /* write out misc. fields as headers */
        aww=strip(word(opts.0,igoo))
        avv='!'||translate(aww)
        if wordpos(avv,'!AUTO_ABSTRACT !ABSTRACT !QUERY_FILE !THREAD ')>0 then iterate
        if wordpos(avv,reflist)>0 then iterate
        buildme=buildme||aww||": "||opts.avv||crlf
    end

    if opts.!AUTO_ABSTRACT=1 then do
         if opts.!ABSTRACT='' then do
             opts.!ABSTRACT=make_abstract(150)
         end 
    end 
    if opts.!ABSTRACT<>'' then
       buildme=buildme||'Abstract: '||translate(opts.!abstract,' ','0d0a0901'x)||crlf


    if opts.!THREAD='' then do
         opts.!THREAD=message_id
    end
    buildme=buildme||'Thread: '||translate(opts.!thread,' ','0d0a0901'x)||crlf


    buildme=buildme||'Content-Length: '||length(opts.!CONTENT)||crlf
    buildme=buildme||asubject||crlf
    buildme=buildme||crlf||opts.!CONTENT

/* do a size check */
kk=sreh2_value('SU_MESSBOX_MAXSIZE',,host_nickname)

    max_messagebox_size=sreh2_value('SU_MESSBOX_MAXSIZE',,host_nickname)

    if (msize+length(buildme))>(max_messagebox_size*1000) then 
           return '-1,Message box is full: your message will not be retained.'

   foo=sre_append_file(lfile,crlf||buildme,3,1)
   if abbrev(foo,'-')=1 then 
        return '-1,Unable to open, or write to, the message box file for: ' gotbox

  end

  otherwise do          /* write as a seperate message to mail dir ? */

     amaildir=sreh2_value('SU_MAIL_DIR',,host_nickname)  /* which directory to write to? */

     lenmess=length(opts.!CONTENT)

     boome='Date: '||dateval||crlf
     boome=boome||zfrom
     if emailval<>' ' then
         boome=boome||'  <'||emailval||'>'
     boome=boome||crlf||'To: '||gotbox||'@'||servername||crlf
     boome=boome||'X-NoArchive: NO '||crlf
     boome=boome||'Content-Length: '||lenmess||crlf
     boome=boome||asubject||crlf||crlf
     boome=boome||opts.!CONTENT||crlf

/* check to make sure that contents of message, + current contents of MAIL directory,
   do not exceed maxsize */

     lenmess2=length(boome)
     mailmax=sreh2_value('SU_MAIL_MAXSIZE',,host_nickname)
     if lenmess2>(1000*mailmax) then return '-1,Size of message exceeds maximum of 'mailmax'K '

     garf=sysfiletree(amaildir||'\*.*','garf2','F')
     tsize=lenmess2
     do jj=1 to garf2.0
       tsize=tsize+strip(word(garf2.jj,3))
     end 
     if tsize>(1000*mailmax) then return '-1,Mail directory is full: your message will not be retained '

/* size is okay -- write it */
     dumpfile=sre_tempfile('_M??????.NOT','?',amaildir)
     fii=charout(dumpfile,boome,1)
     gpp=stream(dumpfile,'c','close')
     if fii>0 then return "-1,Warning: problem writing message to own file "dumpfile)
     if verbose>2 then call sre_pmprintf(" Wrote message from " fromval " to " dumpfile)
  end
end

/* also, or only, broadcast this? */
if broadcast_list<>' ' then do       /* broadcast this to the broadcast_list */
 /* read the "broadcast" list. It's gotta be relative to messbox_dir */
   if broadcast_name='' then broadcast_name='Message processor at 'servername

    puds=sre_read_file(ylfile,2,2,1)
    if puds='' then
        return  '-1,Unable to read e-mail-broadcast list: ' broadcast_list

    apuds=''
    do until puds=''
       parse var puds p1 '/*' . '*/' puds
       apuds=apuds||p1||' '
    end 

    namesl=strip(translate(apuds,' ','0d0a09'x))

    dacontents=asubject||crlf||zfrom||crlf||crlf||opts.!CONTENT
    agateway=sreh2_value('SU_SMTP_GATEWAY',,host_nickname)
    if agateway=' ' then do
        return '-1,Server error: No SMTP gateway specified '
    end

    if length(dacontents)>(1000*mailmax) then 
       return '-1,Size of full message exceeds maximum of 'mailmax'K '

    status=sreh2_mailit(namesl,dacontents,agateway ,broadcast_name,verbose)
    if status=0 then do
         return '-1,Server error: Broadcast failed: via' agateway ', to  ' broadcast_list
    end
end             /* end of broadcast section */


/* now return non-error response */

if response_file<>'' then do
  return '1,'||response_file
end

if broadcast_only=0 then do
  if write_to_file<>1 then
     ams1='Message delivered to message box:'  gotbox
  else
     ams1='Message retained as a 'gotbox' file'

  if broadcast_list<>' ' then 
       ams1=ams1||', and broadcast to '||broadcast_list
end
else do
  ams1='Message broadcast to: ' broadcast_list 
end

return  '0,'||ams1

/*****************/
/* make a message abstract */
make_abstract:procedure expose opts.
parse arg maxlen
if datatype(maxlen)<>'NUM' then maxlen=150
if length(opts.!content)<maxlen then return opts.!content
a150=left(opts.!content,maxlen)

oo=lastpos('.',a150)
if oo>0 then a150=left(a150,oo)
return a150


/* ----------------------------------------------------------------------- */
/* create a form  that displays currently available message boxes
 and allows client to select which one to display */
/* ----------------------------------------------------------------------- */

what_messbox: procedure expose tempfile messbox_dir verbose id_info  host_nickname
parse arg alist

opts.=''
crlf='0d0a'x
do until alist=''
   parse var alist opt1 '&' alist
   parse var opt1 avar '=' aval
   avar=sre_packur(avar)
   vv='!'||strip(translate(avar))
   opts.vv=strip(sre_packur(translate(aval,' ','+'||'0d0a09'x)))
   opts.0=opts.0||' '||vv
end


header=opts.!HEADER
header=sre_packur(translate(header, ' ', '+'||'090a0d'x))
if header=" " then 
    header='<h3>Message Boxes</h3> Which message box would you like to examine?<br>'

footer=opts.!FOOTER
header=sre_packur(translate(header, ' ', '+'||'090a0d'x))
if footer=" " then 
    footer='<a href="/" onClick="window.close(); return false ">Close</a> || <a href="javascript:history.go(-1)">Back.. </a>'

viewer=opts.!VIEWER

call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<html><head><title>Message Box Selection</title></head>"
ee=messbox_dir||"\*.LOG"
eej=sysfiletree(ee,'gotlog','F')

/* no messages box files? */
if gotlog.0=0 then do
  call lineout tempfile,' <STRONG> No messages boxes exist ! </strong> '
  call lineout tempfile,'<hr> '||opts.!FOOTER
  call lineout tempfile,'</body> </html> '
  call lineout tempfile
  rcode=sre_command('FILE  ERASE TYPE text/html  NAME ' tempfile,,id_info)
  return rcode
end

/* else, create a form with message boxes listed therein */

call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'

call lineout tempfile, "<body>"|| header

if viewer=' ' then do
    viewer='/MESSAGE'
    call lineout tempfile,' <FORM ACTION="'||viewer||'" METHOD="GET"> '
    call lineout tempfile,'<Input type="hidden" name="mode" value="VIEW">'
end
else do
    call lineout tempfile,' <FORM ACTION="'||viewer||'" METHOD="GET"> '
end

i5=gotlog.0
if i5>5 & i5<16 then i5=trunc(5+(i5/3))
if i5>15 then i5=10

call lineout tempfile,'<table><tr>'

call lineout tempfile,'<td> <SELECT NAME="messbox" SIZE='||i5||'> '


do mm=1 to gotlog.0
   aff=filespec('name',gotlog.mm)
   parse  var aff affname "." .
   affname=translate(affname)
   al2='<OPTION value="'||affname||'" >'||affname
   call lineout tempfile,al2
end
call lineout tempfile,'</SELECT>'
call lineout tempfile,'</td><td>'
call lineout tempfile,'<INPUT name="format" TYPE="radio" VALUE="1" checked> Display formatted contents'
call lineout tempfile,'<INPUT name="format" TYPE="radio" VALUE="2"> Display formatted abstracts'
call lineout tempfile,'<INPUT TYPE="submit" VALUE="Get Contents of Message Box">'

call lineout tempfile,'</td></table>'

call lineout tempfile,'</FORM> <hr>'||footer

call lineout tempfile,'</body> </html>'
call lineout tempfile

rcode=sre_command('FILE ERASE TYPE text/html  NAME ' tempfile,,id_info)
return 1

/* ----------------------------------------------------------------------- */
/* Set up a return string containing the entire contents of
a chosen message box -- return as text/plain document  */
/* ----------------------------------------------------------------------- */

viewmessage: procedure expose  enmadd  tempfile messbox_dir verbose opts. uri id_info privset ,
                  host_nickname seperator listorig servername
abox=opts.!MESSBOX
tabox=strip(translate(abox))

/* Is this NOT one of the "open access" message boxes?
   Then check to see if client has access rights to this message box */

opens=translate(sreh2_value('SU_OPEN_MESSBOX',,host_nickname))
okay=0
if wordpos('*',OPENS)>0 | wordpos(translate(tabox),opens)>0 then do
  okay=1
end 
else do
  tprivset=translate(privset)
  if wordpos('SUPERUSER',tprivset)>0 then do
      okay=1
  end 
  else do
    do iu=1 to words(privset)
      aww=word(privset,iu)
      if abbrev(aww,'MESSBOX:')=0 & abbrev(aww,'MESSBOX=')=0 then iterate
/* a messagebox privilege -- does it match this messagebox ? */
      AWW=SUBSTR(AWW,9)               /*DROP MESSBOX= prefix*/
      OKAY=sre_wild_match(tabox,AWW)
      if okay<>0 then leave
    end
  END
end

if okay=0 then return '-2,You do not have viewing privileges for the '||abox||' Message Box '


if abox='' then do
   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
   call lineout tempfile, "<html><head><title>Messages Can Not Be Viewed</title></head>"
   call lineout tempfile, "<body>"
   call lineout tempfile, "<h3>Message box was not specified </h2>"
   call lineout tempfile,'<a href="/" rel="Parent"> Return to home page </a>'
   call lineout tempfile, "<hr></body></html>"
   call lineout tempfile
   rcode=sre_command('FILE ERASE TYPE text/html NAME '||tempfile,,id_info)
   return rcode
end
t1=messbox_dir||"\"||abox||".LOG"

ause=stream(t1,'c','query exists')
if ause="" then do
   call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'

   call lineout tempfile, "<html><head><title>Messages Can Not Be Viewed</title></head>"
   call lineout tempfile, "<body>"
   call lineout tempfile, "<h2>Could not view message box </h2>"
   call lineout tempfile, " Could not find the " abox " message box. <hr>"
   call lineout tempfile,'<a href="/" rel="Parent"> Return to home page </a>'
   call lineout tempfile, "<hr></body></html>"
   call lineout tempfile
   rcode=sre_command('FILE ERASE TYPE text/html NAME '||tempfile,,id_info)
end
else do
   if opts.!FORMAT=0 | opts.!FORMAT='' then do
        rcode= sre_command('FILE TYPE text/plain nocache NAME '||strip(t1),,id_info)
   end
   else do
      call viewmessage_format
   end 
end

return rcode

/* -------------------- */
/* -- return a formatted version of a message box; or a cached version of it */
viewmessage_format:


/* possibly use cache? */
/* look in dir cache? */
cache=1
if cache=1 then do              /* is file caching supported? */
   mx=sre_value('H2_FILECACHE_MAXFILES',,'SRE')
   if mx=0 then cache=0
   if opts.!CACHE=0 then cache=0
end

arf=sre_read_file(t1,3,4,1)
parse var arf statline '0d0a'x astring

if abbrev(statline,'-')=1 then do
  return 'string Sorry. Could not read message box file: 'statline||' ,'||length(astring)
end 

if cache=1 then do
   hash=strip(translate(listorig))||' '||statline
   hash=c2x(stringcrc(hash))
   hashname=host_nickname||':MESSAGE?'||hash
   gotcfile=sreh2_file_cache(hashname,,,id_info,'GET')
   parse var gotcfile jstat jname

   if jstat=1 | jstat=2 then do  /* use cache entry */
      if VERBOSE>1 then call sre_pmprintf("MESSAGE: using cached file "jname)
      rcode=sre_command('FILE type text/html nocache etag_auto name '||jname,,id_info)
      return rcode
   end

/* not cached. So we can cache it later (using non-transient tempfile)! */
     csh_dir=sre_value('H2_FILECACHE_DIR')
     tempfile=sre_tempfile('_MES????.CSH','?',csh_dir)
end

max_inmess=opts.!format
rcode=viewmessage_format2(t1,tempfile,abox,seperator||'0d0a'x,id_info,,
                          max_inmess,uri,opts.!messnum,cache)

params='FILE='||tempfile||' ;  STATUS=ASIS '
foo=sreh2_file_cache(hashname,params,0,,'PUT')  /* do not wait for answer */


return rcode

/* ---------------- */
viewmessage_format2:procedure expose astring opts. servername

parse arg t1,tempfile,abox,seperator,id_info,mess1_maxsize,uri,messnum,abstract,cache


/* 1 means "default" (1000)
   2 means "no message, but show a "display full message link" */

parse var astring intro (seperator) astring
if intro='' then intro='<em>In the 'abox' message box </em>'

qsorted=opts.!sorted

messnum_raw=0           /* messnum points to sorted messages */
if abbrev(messnum,'_')=1 then do
   messnum_raw=1                /*messnum points to unsorted messages */
   messnum=substr(messnum,2)
end 

/* parse the messages! */
mess.=''
agr='FORMAT='||mess1_maxsize
if mess1_maxsize=1 then mess1_maxsize=''
if mess1_maxsize='' then mess1_maxsize=1000

ithm=0
do until astring=''
   parse var astring amess (seperator) astring
   if amess='' then iterate
   ithm=ithm+1
/* parse amess */
   do forever
      parse var amess aline '0d0a'x amess
      if aline='' then do               /* blank line signals end of headers */
          mess.ithm.!!message=amess
          leave
      end 
      if amess='' then leave            /* empty message */
      parse var aline avar ':' aval
      avar=translate(avar,'_','-')
      avar='!'||strip(translate(avar))
      if avar='!MESSAGE_ID' then do
         v3='!'||strip(translate(aval))
         mess.v3=ithm
      end
      mess.ithm.avar=strip(aval)
   end 
end 
mess.0=ithm

if messnum<>'' then
   call lineout tempfile, "<html><head><title>View a message</title>"

else
  call lineout tempfile, "<html><head><title>View a message box</title>"

if opts.!QUERY_FILE<>'' then do
  parse var opts.!QUERY_FILE u1 '?' .
  if abbrev(strip(translate(u1)),'HTTP://')=0 then
        u1=u1||'http://'||servername||'/'||u1
  call lineout tempfile,'<base href="'||u1||'">'
end
call lineout tempfile,"</head>"
call lineout tempfile, '<body bgcolor="#b5c8c2">'

call lineout tempfile, '<font size=-1>'
call lineout tempfile,'<table><tr><td>'
call lineout tempfile,'<a href="javascript:close()">close</a>'
call lineout tempfile,'||<a href="javascript:history.go(-1)">back</a>'
if messnum='' then do                   /* create alternate vu links */
  if mess1_maxsize<6 then do
    parse upper var uri p1 (agr) p2
    newuri=make_newuri(p1,'FORMAT=1',p2)
    call lineout tempfile,' || <a href="'||newuri||'">Messages</a>'
  end
  else do
    call lineout tempfile,' || Messages '
  end
  if mess1_maxsize<>2  then do
    parse upper var uri p1 (agr) p2
    newuri=make_newuri(p1,'FORMAT=2',p2)
    call lineout tempfile,' || <a href="'||newuri||'">Abstracts</a>'
  end
  else do
    call lineout tempfile,' || Abstracts '
  end
  if mess1_maxsize<>3 | mess1_maxsize>3 then do
    parse upper var uri p1 (agr) p2
    newuri=make_newuri(p1,'FORMAT=3',p2)
    call lineout tempfile,' || <a href="'||newuri||'">Index</a>'
  end
  else do
    call lineout tempfile,' || Index '
  end
end

call lineout tempfile,'</td>'

if messnum<>'' then call make_navlinks           /* a few navigation links for single message */

call make_Jumps         /* header, and a jump list */

call lineout tempfile,'<table bgcolor="lightgrey"><tr><td>'||intro||'</td></table>'

/*now write messages into a table */
call lineout tempfile,'<table border=1 bgcolor="#aabbaa"> '

if opts.!QUERY_FILE<>'' then do         /* use this shorthand for message-writing form */
  parse var opts.!query_file garg '?' .
  ja=lastpos('/',garg)
  qfile=substr(garg,ja+1)
end

ispad='&nbsp;.'
if qsorted=1 then do    /* sort into threads, by order of appearance */
   call make_qsort
   if qsort.0.!ngens>3 then ispad='.'
end 

do mm00=1 to ithm      /* ======= NOW display all (or 1 selected) messages  === */

  if qsorted<>1 then do
     mm=mm00  /* if not sorted, use order of appearance */
     ilevel=1
     indent=''
  end
  else do
     mm=qsort.mm00
     ilevel=qsort.mm00.!lvl
     indent=make_indent(ilevel,1,ispad,6)
  end

  if messnum<>'' then do
    if messnum_raw=1 then do
       if messnum<>mm then iterate
    end
    else do
      if viewnum<>mm00 then iterate
    end
    mess1_maxsize=100000
  end 

  asubject=sre_html_encode(mess.mm.!SUBJECT)

  call lineout tempfile,'<tr>'
  if  mess1_maxsize<>3 then 
    call lineout tempfile,'<td rowspan=2> '
  else
    call lineout tempfile,'<td> '

  if  mess1_maxsize<>2 & mess1_maxsize<>3 then    /* add date if not index or abstract modes */
      call lineout tempfile,'<font size=-1><em>'||mess.mm.!date||'</em></font>&nbsp;<br>'

  if doevery='' then do
       call lineout tempfile,'<font size=-1><tt>'||Mm||':'||indent||'</tt></font>'
  end
  else do                      /* add jump destinations? */
       if mm00//doevery=0 then 
          call lineout tempfile,'<font size=-1><tt>'||'<a name="jump'||mm00||'">'||Mm||':'||'</a>'||indent||'</tt></font>'
       else
          call lineout tempfile,'<font size=-1><tt>'||Mm||':'||indent||'</tt></font>'
  end 

  afrom=mess.mm.!from
  from_trunc=''
  if messnum='' then do
       afrom=make_from(afrom,28,ilevel)
       if right(afrom,2)='..' then from_trunc=1
  end

  call lineout tempfile,'<a href="mailto:'||mess.mm.!E_MAIL||'">'||afrom||'</a>&nbsp;</nobr>'
  call lineout tempfile,'</td>'

/* right hand column has two rows */
   if mess1_maxsize<>3 then do
     call lineout tempfile,'<td bgcolor="#bbccaa">Subject: <b>'||asubject||'</b></td>'
   end
   else do
     aa='<a target="message_1" href="'||uri||'&messnum='||mm00||'">'
     call lineout tempfile,'<td bgcolor="#bbccaa">'||aa||'Subject</a>: <b>'||asubject||'</b></td>'
   end

/* fill in contents cell (2nd row, 2nd column */
   if mess1_maxsize<>3 then do
     call lineout tempfile,'<tr><td bgcolor="#bbccbb">'
     call fig_mess           /* 2nd row of 2nd column returns set in aa */
     call lineout tempfile,aa
     call lineout tempfile,'</td>'
  end

/* bottom row (1 message mode */
   if messnum<>'' then do
      call lineout tempfile,'<tr><td colspan=2><pre>'
      smess=sre_html_encode(themess)
      call lineout tempfile,smess
      call lineout tempfile,'</pre></td>'
   end 


end 
call lineout tempfile,'</table>'

dd=stream(t1,'c','query datetime')
parse var dd adate atime 
adate=translate(adate,'/','-')
adate=dateconv(adate,'U','N')
dd=adate||' '||atime

call lineout tempfile, "<hr>"

if opts.!QUERY_FILE<>'' & opts.!QUERY_FILE<>0 then do
  call lineout tempfile,'<a target="message_write" href="'||opts.!QUERY_FILE||'">Submit a new message</a>'
  call lineout tempfile, "<br>Messages last updated: "||dd
end 
else do
   call lineout tempfile, "<br>Messages last updated: "||dd
end
call lineout tempfile,"</body></html>"
call lineout tempfile

if cache=0 then
  rcode=sre_command('FILE ERASE TYPE text/html etag_auto NAME '||tempfile,,id_info)
else
  rcode=sre_command('FILE nocache TYPE text/html etag_auto NAME '||tempfile,,id_info)


return 1


/************/
/* make a uri option list */
make_newuri:procedure
parse arg p1,p2,p3
p1=strip(p1) ; p3=strip(p3) ; p2=strIP(p2)
if p1<>'' then do
   if right(p1,1)<>'&' then p1=p1||'&'
end 
if p3<>'' & p2<>'' then do
   if left(p3,1)<>'&' then p3='&'||p3
end
nn=p1||p2||p3
return nn

/************/
/* make internal jumps */
make_jumps:
doevery=''                      /* make a jump list ? */
if messnum='' then do           /* if displaying all messages */
  if ithm>20 then do    /* create a jump list */
      doevery=20
      if ithm>200 then doevery=30
      if ithm>600 then doever=75
      if ithm>1000 then doevery=100
  end 
  if doevery<>"" then do
    call lineout tempfile,' <td> || <em>goto message #</em> </td><td> '
    do jv=doevery to ithm by doevery
         call lineout tempfile,'<a href="'||uri||'#jump'||jv||'">'||jv||'</a>&nbsp; '
    end
    call lineout tempfile,'</td>'
  end
  call lineout tempfile,'</table></font>'
  call lineout tempfile, '<h3 align="center">Viewing 'ithm' messages</h3>'
end
else do                 /* no jump list if only displaying abstracts */
   call lineout tempfile,'</table></font>'
   call lineout tempfile, '<h3 align="center">Viewing message # '||viewnum||' (of 'ithm' messages)</h3>'
end
return 1



/*** make a few navigation links */
make_navlinks:

viewnum=messnum             /* messnum always refers to the nth "sorted" message */
parse upper var uri a1 'MESSNUM=' a2 '&' a3
call lineout tempfile,'<td> || '
if a3<>'' then a3='&'||a3
if viewnum<2 then do
        call lineout tempfile,'&nbsp;&nbsp;&nbsp; :: '
end
else do
        call lineout tempfile,'<a target="message_1" href="'||a1||'MESSNUM='||viewnum-1||a3||'">prior message</a> :: '
end
if viewnum>=ithm then do
        call lineout tempfile,'&nbsp;&nbsp;&nbsp;'
end
else do
        call lineout tempfile,'<a target="message_1" href="'||a1||'MESSNUM='||viewnum+1||a3||'">next message</a>'
end
call lineout tempfile,'|| <a target="message_vu" href="'||strip(a1||a3,'t','&')||'">all messages</a> </td>'
call lineout tempfile,'</font>'
return 1


/***************/
/* determine what the message area should  contain */
fig_mess:

/* themessage -- message with termanining junke removed */
aa=mess.mm.!!message
ivv0=0
do ivv=length(aa) to 1 by -1   /* strip out trailing crlfs, etc */
  asc=c2d(substr(aa,ivv,1))
  if asc>32 then do 
    themess=left(aa,ivv)
    ivv0=ivv
    leave
  end
end 
if ivv0=0 then themess=''

if mess1_maxsize=3 then do         
  aa=''
  return 1              /* index mode does not use contents cell */
end

crlf='0d0a'x

if mess1_maxsize=2 then do            /* abstract mode (never single message display */
  aa=''
  if  mess.mm.!abstract<>'' then do
    abstract=translate(mess.mm.!abstract,' ','090d0a01'x)
    abstract=sre_html_encode(abstract)
    if length(abstract)>200  then abstract=left(abstract,200)||' ...'
    aa='<font size=-1><b>Abstract: </b>'||abstract||'</font><br>'
  end
  aa=aa||'<a target="message_1" href="'||uri||'&messnum='||mm00||'">... full message </a>'||crlf
  aa=aa||'&nbsp;&nbsp;<font size=-1><em>'||mess.mm.!date||'</em></font><br>'||crlf
  return 1
end


/* not abstract mode */

parent_thread=mess.mm.!thread
vthread=mess.mm.!MESSAGE_ID
istrunc=0           

/* 1 message mode? -- use abstract in right hand cell (full message in bottom row */
if messnum<>'' then do  
  aa='<BR>'
  if  mess.mm.!abstract<>'' then do
    abstract=translate(mess.mm.!abstract,' ','090d0a01'x)
    abstract=sre_html_encode(abstract)
    aa='<font size=-1><b>Abstract: </b>'||abstract||'</font>'||crlf
    if opts.!query_file<>'' then aa=aa||'<br>'||crlf
  end
end
else do         /* all messages mode */
   if length(themess)>mess1_maxsize then do   /* truncate contents ? */
     aa=left(themess,mess1_maxsize)
     istrunc=1
   end 
   else do
      aa=themess
   end
   aa=sre_html_encode(aa)
   if aa='' then 
        aa='<em>no message</em>'
   else
       aa='<pre>'||aa||'</pre>'||crlf
end


if messnum='' & ( istrunc=1 | from_trunc=1)  then aa=aa||'<a target="message_1" href="'||uri||'&messnum='||mm00||'">... full message </a>'||crlf

if opts.!query_file='' then return 1  /* no query file, so no Reply links */

/* add reply links */
v3name=make_from(mess.mm.!from,28,ilevel)
v3name0=left(v3name,min(14,length(v3name)))
if length(v3name0)<length(v3name) then v3name0=v3name0||'..'
v3name0=sre_packur_make(v3name0)
aa=aa||'&nbsp;&nbsp;&nbsp;<a target="message_write" href="'||qfile||,
                        '?'||vTHREAD||'&'||v3name0||'">Reply</a>'||crlf

   
if parent_thread<>vthread then do   /* this is not a 1st generation thread */
  v3='!'||strip(translate(parent_thread))
  igoo=mess.v3
  v3name=make_from(mess.igoo.!from,28,ilevel)
  v3name0=left(v3name,min(14,length(v3name)))
  if length(v3name0)<length(v3name) then v3name0=v3name0||'..'
  v3name0=sre_packur_make(v3name0)
  aa=aa||'&nbsp;&nbsp;&nbsp;<a target="message_write" href="'||qfile||'?'|| ,
         parent_THREAD||'&'||v3name0||'">Reply to: '||v3name||'</a>'||crlf

/* if 1 message, also provide a "view" link to parent thread */
 if messnum<>'' then do
    parse upper var uri a1 'MESSNUM=' a2 '&' a3
    if a3<>'' then a3='&'||a3
    aa=aa||'&nbsp;&nbsp;&nbsp;<a target="message_1" href="'||a1||'MESSNUM=_'||igoo||a3||'">View '||v3name||'</a>  '
 end

end

return 1


/**********/
/* make a "tab-like" indentation, depending on the "level",
   using "achar" as the indentation charater (or string),
   using "nper" of these achars in each indentation, 
   but not using more than "maxchar" characters in an indenation */
make_indent:procedure
  parse arg level,nper,achar,maxchar

  if datatype(maxchar)<>'NUM' then maxchar=12
  if datatype(nper)<>'NUM' then nper=2
  if datatype(level)<>'NUM' then level=2
  if achar='' then achar='&nbsp;'
  stuff=''
  ndo=min(nper*(level-1),12)
  do kk=1 to ndo
       stuff=stuff||achar
  end
  return stuff

/***********/
/* possibly truncate a string to mx chars. If truncated, add ".." to end */
make_from:procedure
parse arg astring,mxc,jlvl
jlvl=min(jlvl,5)
if (length(astring)+(jlvl*2))<mxc then return astring  /* small enough */
astring=left(astring,mxc-(2+(jlvl*2)))||'..'
return astring

/***********/
/* sort into threads, by order of appearance
   Uses mess.n.!THREAD and mess.n.!MESSAGE_ID */
make_qsort:procedure expose mess. qsort.
qsort.=''
tlist.=0
gens.=0
ngens=1

/* 1)see if the messages' thread-id (!THREAD) is currently a known thread. 
      1a)Do this by checking 1 to ngens "thread
      1b) If not, 
         1b1) create a new first generation thread, with
            !THREAD as it's name, and with this message number as
         1b2) this message number is first in the list-of-messages
            for this thread
      1c) If it does exist, in a generation ithgen thread
         1c1) append this message number to the list-of-messages 
              in this thread.
         1c2) Add a new ithgen+1 "generation" thread (do steps 1b1 and 1b2)
         1c3) If necessary, add 1 to ngens
*/          

Do ii=1 to mess.0
    athread=mess.ii.!THREAD ;    aid=mess.ii.!MESSAGE_ID
    if athread='' then athread=aid
    vv='!'||translate(strip(athread)) ; vvm='!'||translate(strip(aid))

    do ng=1 to ngens    /* step 1 */
       ajj=gens.ng.vv.0   /* is there a matching entry in generation ng? */
       if ajj>0 then leave  /* yes, there is */
    end 
    if ajj=0 then do     /* no thread exists with this name -- so create one */
       jj1=gens.1.0+1     /* # of first generation threads -- add to it */
       gens.1.0=jj1
       gens.1.jj1=vv    /* add this thread-id to list of 1st gen threads */
       gens.1.vv.0=1    /* initialize list of messages in this thread */
       gens.1.vv.1=ii   /* with this message as the first message */
    end 
    else do             /* a ng generation thread exists with this name */
       nowat=gens.ng.vv.0+1 /* # of message in this thread -- add to it */
       gens.ng.vv.0=nowat
       gens.ng.vv.nowat=ii  /* point to this message */
       gens.ng.vv.nowat.!name=vvm /* this message starts a ng+1 generation */
       ng1=ng+1
       ngens=max(ngens,ng1)  /* maybe this is first of the ng+1 generation? */
       jj1=gens.ng1.0 + 1    /* # of ng+1 generation threads -- add to it */
       gens.ng1.0=jj1
       gens.ng1.jj1=vvm    /* add this message-id to list of 1st gen threads */
       gens.ng1.vvm.0=1    /* initialize list of messages in this thread */
       gens.ng1.vvm.jj1=ii   /* with this message as the first message */
    end
end 

qsort.0.!ngens=ngens
/* given the tree structure in GENS, order from bottom to top */
qsort.0=0
do n0=1 to gens.1.0     /*  each 1st generation threads */
   vv1=gens.1.n0    /* id of first element in n0'th 1st generation thread */
   a_ii=gens.1.vv1.1  
   QQ=Qsort.0+1 ; QSORT.QQ=A_II ;qsort.qq.!lvl=1 ; ;qsort.0=qq   /* add it now */
   foo=make_qsort1(vv1,1) /* process thread n0 in generation 1 */
end                     /* note that gens. and qsort. are exposed */
return 0


/***********************/
/* recursive procedure to make list from tree */
make_qsort1:procedure expose qsort. gens.
parse arg avv,igen

/* start from second element in a list */

do n1=2 to gens.igen.avv.0 /* process all elements in this thread list */
  a_ii=gens.igen.avv.n1  
  QQ=Qsort.0+1 ; QSORT.QQ=A_II ;qsort.qq.!lvl=igen+1 ; qsort.0=qq   /* add it now */
  newvv=gens.igen.avv.n1.!name   /* this message starts a ng+1 generation */
  igen2=igen+1
  foo=make_qsort1(newvv,igen2)
end
return 1  

    

/* --------------------------End of message box utilities------------------- */



/************************************************/
/************************************************/
errx:
call sre_pmprintf('SRE_UTIL error at 'sigl','rc)
rcode=sre_command('STRING SRE_UTIL error at '||sigl||','||rc,,id_info)
exit rcode





