/* The SREhttp/2 dSurvey program 

TODO determines the action.
1       return space delimited list of instruments. Uses the  xml files in /dsurvey/instruments directory 
2        return an instrument's descriptor file (an xml file )
3       return a session's descriptor file (an xml file )
4       create session descriptor file. If filelist= specified, copy these parameter file to this session's directory  (from the appropriate instrument directory)
5       return space delimited list of sessions. Uses the .xml files in /dsurvey/sessions directory 
6       return  a sessions specific XML "parameter" file. Use a file in the session specific directory
7       create, overwriting if ncessary,  a session specific parameters file (an XML file). Saves to session specific directory
31       return 1 if a session descriptor file exists, 0 otherwise. Checks the dsurvey\sessions directory
33       return a suspended session's descriptor file (a suspend_xml file )
55      return space delimited list of suspended sessions. Uses the .SUSPEND_xml files in /dsurvey/sessions directory 
61       return  an instruments XML "parameter" file. Use a file in the instrument specific directory
75      return session specific allowedUsers.xml file
76      create, overwriting if ncessary,  an instrument specific parameters file (an XML file). Saves to instrument specific directory
121      save a session specific variable. Uses files saved in the DATA directory
122      return a session specific variable. Uses files saved in the DATA directory
124      post a client-accessible file. Use is saved to the dsurvey/data directory. 
131      save a session specific status variable. Uses files saved in the DATA directory
132      return a session specific status variable. Uses files saved in the DATA directory
201     add a new client to this sessions joinList, and to status$users server variable
202     return an xml file containing the client (participant) list for a session 
213     Post a quasi-xml file containing a new client (participant) list for a session
322     return string containing current status of participants (1 line per particpant: id,time,message
331     retrieve a unique client id
332     retrieve a unique reference id
401     add a submitted data row, containing a participants entries, for a session
4011     add a simpleHistory data row, containing a participants simpleHistory variable values, for a session
403     return xml file containing all submitted data
4031    update submitted data: add submitData_current.txt to submitData.txt
405     return string containing all the submit messages
421     backup a survey sessions file
431     append a record, or records, to a sessions quasi- XML file (for general, results, or users data)
461     return saved data (general, users, results, etc) as XML file
500     accept string in POST request, and return it with appropriate content-disposition header (a hack for saving constructed file to local drive) 
521     post a message to one, or move, session/client specific mailboxes
522     return contents of session/client specific mailbox (and empty it)
523     rebuild contents of session/client specific mailbox (and empty it)
560     email message, using smtp gateway
600     delete session specific files 
601     suspend a session
602     unsuspend a session
711     add not to a sessions comments/notes file
801     setup a list of currently active sessions
802     Save file to /dsurvey/dsurvey.htm
901     return list of scenarios (either in session or instrument directory)
9011     return list of scenarioLists (either in session or instrument directory)

*/

/******** User changeable parameters ***/
/* 
 svydir: root directory for the SREhttp/2 svy addon. If not specified, the dsurvey directory of the srehttp2 directory (recommended)
 wwwdir : root web-accessible directory for the dsurvey addon. If not specified, the dsurvey directory of the home directory (recommended)
*/

svydir=''
wwwdir='' 
debug=0                          /* 0= no display of errors, 1 = include errors at end of output file as comment, 2= as displayed html text (and write call files) */

/******** end of user changeable parameters ***/


parse arg list,servername,verb,tempfile,,
          prog_file,reqnum,verbose,client_ip,privset,,
          uri,host_nickname,idinfo,aiter,attribs,seluse2
crlf='0d0a'x

signal on error name svyerr
signal on syntax name svyerr
signal on novalue name svyerr

verb=strip(translate(verb))
update_verb=0
addon_dir=sre_value('H2_ADDON_DIR_DEFAULT',,'SRE')
if svydir='' then svydir=strip(addon_dir,,'\')||'\dsurvey'

foo=dosisdir(svydir)
if foo=0 then return 'String Error:unable to find dSURVEY addon directory: ('svydir

/* Directories: ---------------------------------------
   wwwdir: root of the dsurvey directory. Must be web accessible . Note that the following directories  are ALL under wwwdir
   instruments_dir : root of the instruments directory.  Contains instrument descriptor files, module files, and other non-changing information about an instrument
   sessions_dir : root ofthe sessions directory. A session named "foo" will have parameter, etc. files stored in sessions_dir\foo
   lookup_dir : root of the participant accessible data directory.  A session named "foo" will have participant accessible files stored in lookup_dir\foo
   data_dir :  root of the transient data directory.  A session named "foo" will have status files, etc. stored in data_dir\foo
---------------------------------------     */

if wwwdir='' then do
  wwwdir=strip(sre_dataDir())
  wwwdir=wwwdir||'\dsurvey'
end
foo=dosisdir(wwwdir)
if foo=0 then return 'String Error:unable to find /dsurvey/ directory: ('wwwdir
sessions_dir=wwwdir||'\SESSIONS'
okk=dosisdir(sessions_dir)
if okk=0 then do
  return 'string unable to find SESSIONS directory: '||sessions_dir
end

data_dir=wwwdir||'\DATA'
okk=dosisdir(data_dir)
if okk=0 then do
  return 'string unable to find DATA directory: '||data_dir
end


instruments_dir=wwwdir||'\INSTRUMENTS'
okk=dosisdir(wwwdir)
if okk=0 then do
  return 'string unable to find INSTRUMENTS directory: ' instruments_dir
end



lookup_dir=wwwdir||'\PINFO'
okk=dosisdir(lookup_dir)
if okk=0 then do
  return 'string unable to find lookup-DATA directory: '||lookup_dir
end


parse var uri thisaddon '?' .
jj=lastpos('/',thisaddon)
mainaddon=left(uri,jj)||'dsurvey.cmd'
root=left(uri,jj)


list0=list              /* might be used for intermediate results */

if list=''  then list='ACTION=HOME'
optname.=''


atype=sre_reqfield('content-type')
if abbrev(strip(translate(atype)),'MULTIPART/FORM-DATA')=1 then do     /* special POST */
   astatus=parse_multipart(list)
   is_multipart=1
end
else do
  do until list=""
      parse var list opt1 '&' list
      parse var opt1 avar '=' aval ; avar=strip(translate(avar)) ; avar2='!'||avar
      optname.avar2=aval
      optname.!0=optname.!0||' '||avar
  end
end


/* TODO must be specified */
if optname.!TODO='' then do
   outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
   outit=outit||'<h3>Sorry</h3>No TODO= argument in call to dSurvey server side script.'||'0d0a'x
   outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
   outit=outit||'</body></html>'
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
   return rcode
end

if optname.!TODO=1 then do              /* new session -- get list of .xml files in /dsurvey/instruments directory */
  instfiles=instruments_dir||'\*.xml'
  goo=sysfiletree(instfiles,'alist','f')
  aa=''
 do mm=1 to alist.0 
      aa=aa||' '||filespec('n',alist.mm)
 end
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',aa,idinfo,,'Content-Type: text/plain') 
  return 1 
end

if optname.!TODO=5 then do              /*   get list of .xml files in /dsurvey/sessions directory */
  instfiles=sessions_dir||'\*.xml'
  goo=sysfiletree(instfiles,'alist','ft')

 aa=''
 do mm=1 to alist.0 
   ffname=word(alist.mm,4);
   ffdate=word(alist.mm,1)
   if (mm=1) then latestDate=ffdate;
   if (ffdate>=latestdate) then do
      latestName=ffname
      latestDate=ffdate
   end 
   aa=aa||' '||filespec('n',ffname)
 end
 if (optname.!LATEST=1) then aa=aa||' ; '||filespec('n',latestName)        /* append at end the name of the  "most recently created" session */

  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',aa,idinfo,,'Content-Type: text/plain') 
  return rcode
end


if optname.!TODO=55 then do              /*    get list of .suspend_xml files in /dsurvey/sessions directory */
  instfiles=sessions_dir||'\*.suspend_xml'
  goo=sysfiletree(instfiles,'alist','f')
  aa=''
 do mm=1 to alist.0 
      aa=aa||' '||filespec('n',alist.mm)
 end
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',aa,idinfo,,'Content-Type: text/plain') 
  return rcode
end


if optname.!TODO=2 then do              /* return an instrument xml file */
  if optname.!FILE='' then do
    outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
    outit=outit||'<h3>Sorry</h3>No FILE= argument in call to dSurvey server side script: '||list||'0d0a'x
    outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
    outit=outit||'</body></html>'
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
    return rcode
  end
  dafile=instruments_dir||'\'||strip(optname.!FILE)
  aa=stream(dafile,'c','query exists')
 if aa='' then do
    outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
    outit=outit||'<h3>Sorry</h3>No such FILE (xml file), in dSurvey server side script: '||list||'0d0a'x
    outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
    outit=outit||'</body></html>'
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
    call pmprintf('DSurvey ERROR: XML file not found ' || dafile)
    return rcode
  end 

  rcode=sre_command('FILE ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   name '||dafile,,idinfo,,'Content-Type: text/xml; charset=iso-8859-1') 
  return rcode

end

if optname.!TODO=3 then do              /* return a survey session xml file */
  if optname.!NAME='' then do
    outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
    outit=outit||'<h3>Sorry</h3>No NAME= argument in call to dSurvey server side script: '||list||'0d0a'x
    outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
    outit=outit||'</body></html>'
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
    return rcode
  end
  dafile=sessions_dir||'\'||strip(optname.!NAME)||".XML"
  aa=stream(dafile,'c','query exists')
 if aa='' then do
    outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
    outit=outit||'<h3>Sorry</h3>No such FILE ('||dafile||'), in dSurvey server side script: '||list||'0d0a'x
    outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
    outit=outit||'</body></html>'
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
    call pmprintf('DSurvey ERROR: session XML file not found ' || dafile)
    return rcode
  end 
  rcode=sre_command('FILE ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   name '||dafile,,idinfo,,'Content-Type: text/xml; charset=iso-8859-1') 
  return rcode
end


if optname.!TODO=33 then do              /* return a suspended survey session xml file */
  if optname.!NAME='' then do
    outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
    outit=outit||'<h3>Sorry</h3>No NAME= argument in call to dSurvey server side script: '||list||'0d0a'x
    outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
    outit=outit||'</body></html>'
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
    return rcode
  end
  dafile=sessions_dir||'\'||strip(optname.!NAME)||".SUSPEND_XML"
  aa=stream(dafile,'c','query exists')
 if aa='' then do
    outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
    outit=outit||'<h3>Sorry</h3>No such FILE (xml file), in dSurvey server side script: '||list||'0d0a'x
    outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
    outit=outit||'</body></html>'
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
    call pmprintf('DSurvey ERROR: session XML file not found ' || dafile)
    return rcode
  end 
  rcode=sre_command('FILE ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   name '||dafile,,idinfo,,'Content-Type: text/xml; charset=iso-8859-1') 
  return rcode
end


if optname.!TODO=6 then do              /* return a survey session's input or parameters xml file */
  sname=strip(optname.!NAME)
  sfile=strip(optname.!FILE)

  if sNAME='' || sfile='' then do
    outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
    outit=outit||'<h3>Sorry</h3>No NAME= or FILE= argument in call to dSurvey server side script: '||list||'0d0a'x
    outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
    outit=outit||'</body></html>'
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
    return rcode
  end
  if pos('.',sfile)=0 then sfile=sfile||'.XML'
  dafile=sessions_dir||'\'||sname||'\'||sfile
  aa=stream(dafile,'c','query exists')
 if aa='' then do
    outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
    outit=outit||'<h3>Sorry</h3>No such FILE (session xml file), in dSurvey server side script: '||dafile||'0d0a'x
    outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
    outit=outit||'</body></html>'
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
    call pmprintf('DSurvey ERROR: sessions input or params XML file not found ' || dafile)
    return rcode
  end 
  rcode=sre_command('FILE ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   name '||dafile,,idinfo,,'Content-Type: text/xml; charset=iso-8859-1') 
  return rcode
end


if optname.!TODO=61 then do              /* return an instrument parameters xml file */
  sname=strip(optname.!NAME)
  sfile=strip(optname.!FILE)

  if sNAME='' || sfile='' then do
    outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
    outit=outit||'<h3>Sorry</h3>No NAME= or FILE= argument in call to dSurvey server side script: '||list||'0d0a'x
    outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
    outit=outit||'</body></html>'
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
    return rcode
  end
  if pos('.',sfile)=0 then sfile=sfile||'.XML'
  dafile=instruments_dir||'\'||sname||'\'||sfile
  aa=stream(dafile,'c','query exists')
 if aa='' then do
    outit='<html><head><title>dSURVEY: error</title></head><body>'||'0d0a'x
    outit=outit||'<h3>Sorry</h3>No such FILE (instrument xml file), in dSurvey server side script: '||dafile||'0d0a'x
    outit=outit||'<p><a target="_top" href="/dsurvey/admin.htm">Return to survey admin page</a>'||'0d0a'x
    outit=outit||'</body></html>'
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',outit,idinfo,,'Content-Type: text/html; charset=iso-8859-1') 
    call pmprintf('DSurvey ERROR: instrument params XML file not found ' || dafile)
    return rcode
  end 
  rcode=sre_command('FILE ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   name '||dafile,,idinfo,,'Content-Type: text/xml; charset=iso-8859-1') 
  return rcode
end


if optname.!TODO=31 then do              /* return 1 if session file exists, 0 otherwise */

  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurvey: no name when todo=31 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','0',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end

  dafile=sessions_dir||'\'||strip(optname.!NAME)||".XML"
  aa=stream(dafile,'c','query exists')
  if aa='' then do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','0',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
    return rcode
  end

  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','1',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode

end

if optname.!TODO=4  then do              /* create session descriptor file (an XML file). Also, if filelist= specified, copy files from instrument to session directory */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurvey: no name when todo=4 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','0',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  newFile=sessions_dir||'\'||optname.!NAME||'.xml'

  overwrite=optname.!OVERWRITE
  if (overwrite<>1) then do
    if (stream(newFile,'c','query exists')<>'') then do
        rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 File exists',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
        return rcode
    end
  end

  stuff=sre_packur(optname.!content)
  foo=sre_append_file(newFile,stuff,3,0,1)

  newdir=sessions_dir||'\'||optname.!NAME
  arf=dosMakeDir(newdir)
  if (arf=0) then do
      rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-2 Unable to create sesssion specific directory',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
      return rcode
  end 

  backdir=sessions_dir||'\'||optname.!NAME||'\BACKUP';
  arf=dosMakeDir(backdir)
  if (arf=0) then do
      rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-2 Unable to create sesssion specific BACKUP directory',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
      return rcode
  end 

/* create session specific "data" directory (for transient/temporary data */
  dnewdir=lookup_dir||'\'||optname.!NAME
  arf=dosMakeDir(dnewdir)
  if (arf=0) then do
      rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-2 Unable to create sesssion lookup directory',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
      return rcode
  end 

/* create session specific "lookup" directory (for client accessible, session specific, files  */
  dnewdir=data_dir||'\'||optname.!NAME
  arf=dosMakeDir(dnewdir)
  if (arf=0) then do
      rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-2 Unable to create sesssion transient data directory',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
      return rcode
  end 

/* now copy files to newdir (from instruments/instName */

  filelist=strip(sre_packur(optname.!FileList))

  if (optname.!DOSCENARIO=1) then do
     thisIdir=instruments_dir||'\'||optname.!instName 
     goo=sysfiletree(thisIdir||'\SC_*.XML','alist','f')
     do mm=1 to alist.0 
        filelist=filelist||' '||filespec('n',alist.mm)
     end
     goo=sysfiletree(thisIdir||'\SL_*.XML','alist','f')
     do mm=1 to alist.0 
        filelist=filelist||' '||filespec('n',alist.mm)
     end

   end

  if (filelist<>'') then do
     thisIdir=instruments_dir||'\'||optname.!instName 
     do mm=1 to words(filelist)
       afile=strip(word(filelist,mm))
       thefile=thisIdir||'\'||afile
       pfileok=stream(thefile,'c','query exists')
       if (pfileok='') then do
            rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-3 No such file='||afile,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
            return rcode
        end
       targetfile=newdir||'\'||afile
       cresult=dosCopy(thefile,targetfile,'R')
       if (cresult<>0) then do
             rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-31 Unable to copy '||targetfile,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
             return rcode
       end
     end 
  end                           /* filelist not empty */

  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||words(filelist)||' files copied',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode
end 




/* return a unique client id  */
if optname.!TODO=75 then do         
   sessname=optname.!session
   bFile=sessions_dir||'\'||sessname||'\allowedUsers.xml'                   /* read the most recent client id */

   rcode=sre_command('FILE ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   name '||bfile,,idinfo,,'Content-Type: text/xml; charset=iso-8859-1') 
   return rcode
end

if optname.!TODO=7 then do              /* overwrite a session's input and or parameters file (an XML file) */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurvey: no name when todo=7 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','0',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  thisDir=sessions_dir||'\'||optname.!NAME||'\'
  thefile=thisdir||optname.!FILE
  stuff=sre_packur(optname.!content)
  foo=sre_append_file(theFile,stuff,3,0,1)
  amess=append_File_Error(foo,thefile,7)

  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode
end

if optname.!TODO=76 then do              /*  write (or overwrite) a parameter file for an instrument (an XML file) */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurvey: no instrument NAME when todo=76 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','0',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  thisDir=instruments_dir||'\'||optname.!NAME||'\'
  thefile=thisdir||optname.!FILE
  stuff=sre_packur(optname.!content)
  foo=sre_append_file(theFile,stuff,3,0,1)
  amess=append_File_Error(foo,thefile,7)
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode
end



/* == control panel stuff == */
if optname.!TODO=121 then do              /* save a session specific variable*/
  sessname=optname.!session
  vname=strip(sre_packur(optname.!VARNAME))
  vval=sre_packur(optname.!value);

  if (words(vname)==1) then do
     afile=data_dir||'\'||strip(sessname)||'\var$'||strip(vname)||'.txt'
     istat=sre_append_file(afile,vval,3,0,1)
     amess=append_File_Error(istat,afile,vval)
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain') 
     return rcode
  end

  adelim=sre_packur(optname.!delim)                             /* more than one vname to save */
  amess2=''
  do iw=1 to words(vname)
         aword=strip(word(vname,iw))
         afile=data_dir||'\'||strip(sessname)||'\var$'||strip(aword)||'.txt'
         parse var vval vval1 (adelim) vval       
         vval1=strip(vval1)
         istat=sre_append_file(afile,vval1,3,0,1)
         amess=append_File_Error(istat,afile,vval1)
         amess2=amess||' || '||amess2
         if (istat<0)  then do
                 rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess2,idinfo,,'Content-Type: text/plain') 
                 return rcode
          end
  end                                /* iw */
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess2,idinfo,,'Content-Type: text/plain') 
  return rcode
end


if optname.!TODO=122 then do              /* read server vars */
   sessname=optname.!session
   vname=strip(sre_packur(optname.!VARNAME))
   aid=strip(sre_packur(optname.!ID))
   adefault=strip(sre_packur(optname.!DEFAULT))
   spying=strip(sre_packur(optname.!SPY))
   
   ndo=words(vname) 
   if (ndo==1 & vname<>'*') then do
         aword=strip(vname)
         afile=data_dir||'\'||strip(sessname)||'\var$'||strip(aword)||'.txt'
         aa=stream(afile,'c','query exists')
         if aa='' then do
            stuff=adefault
         end
         else do
            stuff=sre_read_file(afile,2,3,1)
         end
         rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',stuff,idinfo,,'Content-Type: text/plain') 
        if aid<>'' & spying<>'1' then do                                   /* save status info?       */
             amessage=strip(sre_packur(optname.!SUMMARY)) ;   amessage=translate(amessage,' ','&='||'0d0a09'x)
             astate=strip(sre_packur(optname.!STATE)) ;   astate=translate(astate,' ','&='||'0d0a09'x)
             atime=strip(sre_packur(optname.!TIME)) ;  atime=translate(atime,' ','&='||'0d0a09'x)
             aword=translate(aword,' ','&='||'0d0a09'x)
             stuff=translate(stuff,' ','&='||'0d0a09'x)
          
/*====   report rex time */
            rextime=sre_gmt(,,'JS');
            toput='serverTime='||rextime||' & time='||atime||' & state='||astate||' &  message='||amessage||' & var='||aword||' & value='||stuff
            afile=data_dir||'\'||strip(sessname)||'\status.$'||strip(aid)
            foo=sre_append_file(afile,toput,3,0,1)
          end

         return rcode
   end

/* else, many variables (do NOT save status messages if many variables) */

  stuff=''
  adelim=strip(sre_packur(optname.!DELIM))

/* all server vars for this session? */
  if (vname='*') then do
     ff=data_dir||'\'||strip(sessname)||'\var$*'
     aa=sysfiletree(ff,'ffs.','FO');
     do m=1 to ffs.0
          afile=ffs.m
          fname=filespec('n',afile);
          parse var fname . '$' varname '.' .

         aa=stream(afile,'c','query exists')
         if aa='' then do
             astuff=adefault
         end
         else do
            astuff=sre_read_file(afile,2,3,1)
         end
         astuff=translate(astuff,'','090a0d'x||adelim)
         if (m=1) then do
                stuff=varname||'='||astuff
            end
            else do
                stuff=stuff||adelim||varname||'='||astuff
         end
     end

     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',stuff,idinfo,,'Content-Type: text/plain') 
     return rcode
                 
  end                           /* vaname=* */

   do m=1 to ndo         
    aword=strip(word(vname,m))
    afile=data_dir||'\'||strip(sessname)||'\var$'||strip(aword)||'.txt'

    aa=stream(afile,'c','query exists')

    if aa='' then do
        astuff=adefault
    end
    else do
        astuff=sre_read_file(afile,2,3,1)
    end

    if (m=1) then do
        stuff=astuff
    end
    else do
       stuff=stuff||adelim||astuff
    end
   end

   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',stuff,idinfo,,'Content-Type: text/plain') 
   return rcode
 end                    /* 122 */


if optname.!TODO=131 then do              /* save a session specific status variable*/
  sessname=optname.!session
  vname=strip(sre_packur(optname.!VARNAME))
  vval=sre_packur(optname.!value);
  afile=data_dir||'\'||strip(sessname)||'\status$'||strip(vname)||'.txt'
  istat=sre_append_file(afile,vval,3,0,1)
  amess=append_File_Error(istat,afile,131)
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain') 
  return rcode
end

if optname.!TODO=132 then do              /* read server status vars */
   sessname=optname.!session
   vname=strip(sre_packur(optname.!VARNAME))
    aword=strip(vname)
    afile=data_dir||'\'||strip(sessname)||'\status$'||strip(aword)||'.txt'
   stuff=sre_read_file(afile,2,3,1)
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',stuff,idinfo,,'Content-Type: text/plain') 
    return rcode
end

if optname.!TODO=124 then do              /* post a client-accessible, file. This is saved to the lookup_dir directory. */
   atype=strip(translate(optname.!TYPE))
   select 
     when  (atype=='SESSION') then do
         sessname=strip(optname.!session)
         afile=strip(sessname)||'.XML'
         sessname=optname.!session; sessname=strip(sessname)
         if  sessname=''  then do
               rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-5 no session name for SESSION type ',idinfo,,'Content-Type: text/plain') 
               return rcode
           end 
      end 
      when (atype=='ROUND') then do
         sessname=strip(optname.!session)
         afile='_'||strip(sessname)||'.XML'
         sessname=optname.!session; sessname=strip(sessname)
         if  sessname=''  then do
               rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-5 no session name for ROUND type ',idinfo,,'Content-Type: text/plain') 
               return rcode
           end 
      end 
      otherwise do
         afile=strip(optname.!name)
          if (afile='') then do
               rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-4 no name for OTHER type',idinfo,,'Content-Type: text/plain') 
               return rcode
         end
      end                       /* otherwise */
   end                  /* select */

   stuff=sre_packur(optname.!contents)
   bfile=lookup_dir||'\'||strip(sessname)||'\'||afile
   foo=sre_append_file(bFile,stuff,3,0,1)
   amess=append_File_Error(foo,bfile,124)
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain') 
   return rcode

end                     /* 124 */

/* add a new client to this sessions joinList, and to the status$Users serverside variable */
if optname.!TODO=201 then do         
   sessname=strip(sre_packur(optname.!session))
   aname=strip(sre_packur(optname.!username))
   acontent=strip(sre_packur(optname.!content))

   bFile=sessions_dir||'\'||sessname||'\joinList.txt'
   fexists=stream(bfile,'c','query exists')
   foo=sre_append_file(bFile,acontent,5,1,0)
   amess=append_File_Error(foo,bfile,aname)
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain') 
  
   bFile=data_dir||'\'||sessname||'\status$users.txt'                   /* add this name to user-list */
   foo=sre_append_file(bFile,' '||aname||' ',5,0,0)             /* do NOT append a crlf! */

   return rcode
end


/* return an xml file containing the client list for a session */
if optname.!TODO=202 then do         
   sessname=optname.!session
   bFile=sessions_dir||'\'||sessname||'\joinList.txt';
  stuff=sre_read_file(bfile,2,3,1) 
   nustuff='<?xml version="1.0" encoding="UTF-8" ?>'||'0d0a'x
  nustuff=nustuff||'<users>'||'0d0a'x
  nustuff=nustuff||'<session value="'||sessname||'" />'||'0d0a'x
  nustuff=nustuff||'<created>'||sre_datestamp()||'</created>'||'0d0a'x
  nustuff=nustuff||stuff||'0d0a'x
  nustuff=nustuff||'</users>'||'0d0a'x
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',nustuff,idinfo,,'Content-Type: text/xml') 
  return rcode

end 

if optname.!TODO=213 then do  
   sessname=optname.!session
   daFile=sessions_dir||'\'||sessname||'\joinList.txt';
   acontent=strip(sre_packur(optname.!content))
   foo=sre_append_file(daFile,acontent,5,0,1)
   amess=append_File_Error(foo,daFile,'')
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain') 
  return rcode
end

/* return a unique client id  */
if optname.!TODO=331 then do         
   sessname=optname.!session
   bFile=data_dir||'\'||sessname||'\status$clientid.txt'                   /* read the most recent client id */
  aname=optname.!name
  stuff=sre_read_file(bfile,2,3,1)
  do m=1 to 30                                  /* do 30 times, in case of contention */
     if strip(stuff)='' then do
        cnum=999 ;
     end
     else do
        parse var stuff cnum .
     end 
     cnum=cnum+1
     toput=cnum||' '||aname
     foo=sre_append_file(bFile,toput,3,0,1)
     if foo<0 then iterate                              /* error, try again */
     stuff=sre_read_file(bfile,2,3,1)
     if (stuff<>toput) then iterate
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',cnum,idinfo,,'Content-Type: text/plain') 
     return rcode
   end 
/* if here, 30 attempts didn't work */
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','- Error. Unable to provide unique client id ',idinfo,,'Content-Type: text/plain') 
   return rcode
end


/* return a string containing the participant's status  */
if optname.!TODO=322 then do         
    ddz=digits()
            numeric digits 20
            rextime=sre_gmt(,,'JS');
            jsdays=(14948-7643)+rextime;
            jsMilli=trunc(jsdays* 86400000)
            jsTime=' '||jsMilli||' '  
    numeric digits ddz

/* return javascript time (milliseconds since 1/1/70) */
  nustuff='nowTime='||strip(jsTime)
   sessname=optname.!name
   ff=data_dir||'\'||strip(sessname)||'\status.$*'
   aa=sysfiletree(ff,'ffs.','FO');
   do m=1 to ffs.0                              /* status stuff will have had & an = converted to spaces */
          afile=ffs.m
          fname=filespec('n',afile);
          parse var fname . '$' clientid 
          astuff=sre_read_file(afile,2,3,1)
          nustuff=nustuff||'0d0a'x||'id='||clientid||'&'||astuff
     end
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',nustuff,idinfo,,'Content-Type: text/plain') 
    return rcode
end


/*  add an "xml" data row, to this session "submiitted data" file. Appends to session specific xml file. Actually, appends to an xml file
  that lacks a header line, and an encolsing tag (so it's not a legal xml file until these are added) .
Also add the submit message to the history of submit messages file
Note: if toCurrent=1, add to submittedData_current (rather than all round) archive */

if optname.!TODO=401 then do         

   sessname=strip(optname.!session)
   averify=sre_packur(optname.!verify)
   asubmitStatus=sre_packur(optname.!submitStatus)
   acurrent=sre_packur(optname.!tocurrent)
   if (asubmitStatus<>'') then do
      bfile=data_dir||'\'||strip(sessname)||'\submitStatus.txt'
      stuff=sre_read_file(bfile,2,3,1)
      iat=pos(' '||asubmitStatus||' ',stuff)
      if (iat>0) then do                        /* already have submission for this round, so reject */
           rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','4 Sorry, you have already submitted an entry for this round='||asubmitstatus,idinfo,,'Content-Type: text/plain') 
           return rcode
      end
   end
   stuff=optname.!contents
   message=sre_packur(optname.!message)
   tt3=sre_gmt(,,'JS')
/*==== busted?
       ddz=digits()
       numeric digits 20
       afact=176368512.81007161739                 /* convert JS time to javascript time */
       jrextime=tt3*afact 
       numeric digits ddz
==== */

   message=' serverTime='||tt3||' & '||message
   if (acurrent<>'1') then do
       dafile=sessions_dir||'\'||sessname||'\submitData.txt'
   end
   else do
       dafile=sessions_dir||'\'||sessname||'\submitData_current.txt'
   end
   foo=sre_append_file(daFile,stuff,5,1,0)
   amess=append_File_Error(foo,daFile,averify)
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain') 

   dafile=sessions_dir||'\'||sessname||'\submitMessages.txt'
   istat=sre_append_file(dafile,message,3,1,0)
   bfile=data_dir||'\'||strip(sessname)||'\submitStatus.txt';
   foo=sre_append_file(bFile,' '||asubmitStatus||' ',3,0,0)

   return rcode
end 


/*  add an "xml" data row, to this session "simpleHistory" archive.
   Appends to session specific xml file. Actually, appends to an xml file
  that lacks a header line, and an encolsing tag (so it's not a legal xml file until these are added) .
*/
if optname.!TODO=4011 then do         
   sessname=strip(optname.!session)
   stuff=optname.!contents

   dafile=sessions_dir||'\'||sessname||'\simpleHistory.txt'
   foo=sre_append_file(daFile,stuff,5,1,0)
   amess=append_File_Error(foo,daFile,' simpleHistoryUpload ')
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain') 
   return rcode
end 


if optname.!TODO=403 then do   
   iscurrent=strip(optname.!current)
   sessname=strip(optname.!session)
  if (iscurrent=1) then
      dafile=sessions_dir||'\'||sessname||'\submitData_current.txt'
  else
      dafile=sessions_dir||'\'||sessname||'\submitData.txt'
   stuff=sre_read_file(dafile,2,3,1) 
   aline='<?xml version="1.0" encoding="UTF-8" ?>'
   stuff=aline||'0d0a'x||'<submittedData>'||'0d0a'x||stuff||'0d0a'x||'</submittedData>'||'0d0a'x
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/xml; charset=iso-8859-1') 
   return rcode
end

if optname.!TODO=4031 then do   
   sessname=strip(optname.!session)
   curfile=sessions_dir||'\'||sessname||'\submitData_current.txt'
   dafile=sessions_dir||'\'||sessname||'\submitData.txt'
   stuff=sre_read_file(dafile,2,3,1) 
   cstuff=sre_read_file(curfile,2,3,1) 
   nustuff=stuff||'0d0a'x||cstuff
   foo1=sre_append_file(daFile,nustuff,3,0,1)
   foo=sre_append_file(curFile,'',3,0,1)
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',foo1,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
   return rcode 
end 

if optname.!TODO=405 then do   
   sessname=strip(optname.!session)
   dafile=sessions_dir||'\'||sessname||'\submitMessages.txt'
   stuff=sre_read_file(dafile,2,3,1) 
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain charset=iso-8859-1') 
   return rcode
end

/* backup a asesions files */
if optname.!TODO=421 then do   
   sessname=strip(optname.!session)

   cres.='copy error ';
   cres.2=' Error: could not find original file'       
   cres.3=' Error: could not find directory for original file '
   cres.5=' Error: file already exists '
   cres.108=' Error: drive is locked '
   cres.32=' Error: sharing violation '
   cres.112=' Error: disk full '
   cres.206='Invalid file name '
   cres.0=' Success. '
   nowdate=sre_datestamp()
   parse var nowdate . a1 a2 a3 a4 . 
   dd='_'||a1||'_'||a2||'_'||a3||'_'||translate(a4,'_',':')

   stuff='<ul>'

   backupdir=sessions_dir||'\'||sessname||'\BACKUP\';

   dafile=sessions_dir||'\'||sessname||'.xml'
   newfile=backupdir||filespec('n',dafile)||dd

   foo=doscopy(dafile,newfile)
   stuff=stuff||'<li> Backup of session descriptor file <tt> '||filespec('N',dafile)||'</tt> <span style="color:blue;padding-right:6px ; padding-left:6px"> to </span> <tt> '||filespec('N',newfile)||'</tt>: '||cres.foo||'</li>'

   dafiles=sessions_dir||'\'||sessname||'\*.xml'
   info=sysfiletree(dafiles,'fdone.','FO')
   do m=1 to fdone.0
      dafile=fdone.m
      newfile=backupdir||filespec('n',fdone.m)||dd
      foo=doscopy(dafile,newfile)
      stuff=stuff||'<li>'||'Backup of session XML file <tt>'||filespec('n',dafile)||' </tt> <span style="color:blue;padding-left:6px;padding-right:6px"> to </span> <tt> '||filespec('n',newfile)||'</tt>: '||cres.foo||'</li>'
   end

   dafiles=sessions_dir||'\'||sessname||'\*.txt'
   info=sysfiletree(dafiles,'fdone.','FO')
   do m=1 to fdone.0
      dafile=fdone.m
      newfile=backupdir||filespec('n',fdone.m)||dd
      foo=doscopy(dafile,newfile)
      stuff=stuff||'<li>'||'Backup of session text file <tt>'||filespec('N',dafile)||'  </tt><span style="color:blue;padding-left:6px;padding-right:6px"> to </span>  <tt>'||filespec('N',newfile)||'</tt>: '||cres.foo||'</li>'
   end

   stuff=stuff||'</ul>'
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain charset=iso-8859-1') 
   return rcode
end


/* append a row (or rows) containing xml data to a sessions "XML data" file (general, results, or users) */
if optname.!TODO=431 then do         
   sessname=optname.!session
   atype=optname.!type; atype=strip(translate(atype))
   cname=strip(optname.!cname)
   if (atype<>'GENERAL' & atype<>'USERS'  & atype<>'PARTICIPANTS' & atype<>'RESULTS'  & atype<>'HISTORY'  & atype<>'CUSTOM') then do
         rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','- Error. Bad type: '||atype,idinfo,,'Content-Type: text/plain') 
        return rcode
   end
   if atype=='CUSTOM' then do
      daFile=sessions_dir||'\'||sessname||'\save_'||cname||'.txt';
   end
   else do
      daFile=sessions_dir||'\'||sessname||'\save'||atype||'.txt';
   end
   acontent=strip(sre_packur(optname.!contents))
   foo=sre_append_file(daFile,acontent,5,1,0)
   amess=append_File_Error(foo,daFile,'')
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain') 
   return rcode
end

/* return save data as xml file */
if optname.!TODO=461 then do         
   sessname=optname.!session
   atype=optname.!type; atype=strip(translate(atype))
   if (atype<>'SIMPLEHISTORY' & atype<>'SUBMITTED' & atype<>'GENERAL' & atype<>'USERS'  & atype<>'PARTICIPANTS' & atype<>'RESULTS'  & atype<>'HISTORY'  & atype<>'CUSTOM') then do
         rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','- Error. Bad type: '||atype,idinfo,,'Content-Type: text/plain') 
        return rcode
   end


   if atype=='CUSTOM' then do
      cname=strip(optname.!cname)
      daFile=sessions_dir||'\'||sessname||'\save_'||cname||'.txt';
   end
   else do
     if atype=='SUBMITTED' then do
        daFile=sessions_dir||'\'||sessname||'\submitData.txt';
     end 
     else do
       if atype=='SIMPLEHISTORY' then do
           daFile=sessions_dir||'\'||sessname||'\simpleHistory.txt';
       end
       else do
          daFile=sessions_dir||'\'||sessname||'\save'||atype||'.txt';
       end
     end
   end
   stuff=sre_read_file(dafile,2,3,1) 
   nustuff='<?xml version="1.0" encoding="UTF-8" ?>'||'0d0a'x
   nustuff=nustuff||'<data_'||atype||'>'||'0d0a'x
   nustuff=nustuff||stuff||'0d0a'x
   nustuff=nustuff||'</data_'||atype||'>'||'0d0a'x
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',nustuff,idinfo,,'Content-Type: text/xml') 
   return rcode
end


/* given a file, as an escaped string with + for spaces,return it in its unescaped (and ' ' for +) form. Include content-disposition: attachment header to force
   browser to "save this file" to the hard drive.
   Also, use the filename variable to specify what filename should be used as the default name. */

if optname.!TODO=500 then do    
   afile=optname.!filename
   if afile='' then afile='submitted.xml ';
   stuff=translate(optname.!contents,' ','+');
   stuff=sre_packur(stuff)
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1'||'0d0a'x||'Content-disposition: attachment ; filename='||afile) 
   return rcode
end


/*  post to mailboxes (always post to the $ALL mailbox) */
if optname.!TODO=521 then do    
   sessname=optname.!session
   atime=optname.!time
   afrom=optname.!fromid
   afromName=optname.!fromName
   clientids=strip(optname.!clientList)
   clientids=translate(clientids,' ',',')
   aurgent=optname.!urgent

   asubject=optname.!subject
   if (strip(translate(verb))='GET') then do
      asubject=sre_packur_make(optname.!subject,1)
   end
   
   amessage=optname.!message
   if (strip(translate(verb))='GET') then do
       amessage=sre_packur_make(optname.!message,1)
   end

   amessage1=aurgent||','||atime||','||afrom||','||afromName||','||','||asubject||','||amessage
   amessageA=aurgent||','||atime||','||afrom||','||afromName||','||clientids||','||asubject||','||amessage

  daFile=lookup_Dir||'\'||sessname||'\messages_$ALL.txt'
  foo=sre_append_file(daFile,amessageA,5,1,0) 
  if foo<0 then do
      stuff=append_File_Error(foo,daFile,'')
      rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
      return rcode
  end

   do mm=1 to words(clientids)
       aclient=strip(word(clientids,mm))
       if (aclient=='') then iterate
       daFile=lookup_Dir||'\'||sessname||'\messages_'||aclient||'.txt'
       foo=sre_append_file(daFile,amessage1,5,1,0)
       if foo<0 then do
         stuff=append_File_Error(foo,daFile,'')
         rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
         return rcode
       end
    end
    stuff='ok Message sent to '||words(clientids)||' participants: '||clientids
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
    return rcode
end

/*  retrieve from mailbox */
if optname.!TODO=522 then do    
   sessname=optname.!session
   aclient=strip(optname.!client)
   doerase=strip(optname.!erase)
   daFile=lookup_Dir||'\'||sessname||'\messages_'||aclient||'.txt'
   afile=stream(daFile,'c','query exists')

   if afile='' then do
      stuff=''
   end
   else do
     stuff=sre_read_file(dafile,2,3,1) 
     if doerase=='1' then do 
         ares=sysfiledelete(dafile)
         if (ares<>0) then do
            stuff='ERROR: unable to empty message box for '||aclient||' : ' ||errcodes.ares
         end 
     end
   end
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain charset=iso-8859-1') 
   return rcode

end


/* rebuild a message box */
if optname.!TODO=523 then do    

   sessname=optname.!session
   aclient=optname.!client
   amessage=optname.!message
   if (strip(translate(verb))='GET') then do
       amessage=sre_packur_make(optname.!message,1)
   end

   if (aclient=='') then iterate
   daFile=lookup_Dir||'\'||sessname||'\messages_'||aclient||'.txt'

   if (stream(dafile,'c','query exists')<>'')  then foo=sysfiledelete(dafile)                    /* error (say, no such file is okay */
   foo=sre_append_file(daFile,amessage,5,1,0)

   if foo<0 then do
         stuff=append_File_Error(foo,daFile,'')
         rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
         return rcode
    end

    stuff='ok Message box rebuilt: '||aclient
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
    return rcode
end


if optname.!TODO=77 then do              /* recieve an uploaded file, and send it back */
  tmp=optname.!myname
   stuff=sre_packur_make(optname.!myname,1)
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
   return rcode
end


if optname.!TODO=600 then do              /* delete session specific files */
   sessname=strip(optname.!session)
   step=strip(optname.!step)
   fake=strip(optname.!fake)
   if (fake<>'1') then fake=0

  errcodes.='Other file removal error '
  errcodes.0='Successfully deleted '
    errcodes.2='Error: file not found '
    errcodes.3='Error: file path not found '
    errcodes.5='Error: access denied'
    errcodes.32='Error: sharing violation '

  derrcodes.='Other directory removal error '    
  derrcodes.0='Directory successfully removed '
   derrcodes.2='Error: directory not found '
    derrcodes.3='Error: directory path not found '
    derrcodes.5='Error: access denied'
    derrcodes.16='Error: current directory'
    derrcodes.108='Error:  drive locked'

   if (step=1) then do          /* step 1: kill session descriptor file */
      dafile=sessions_dir||'\'||sessname||'.XML'
      info=stream(dafile,'c','query datetime')
      asize=stream(dafile,'c','query size')

      if fake=1 then do
          stuff='OK : session descriptor file would be deleted: <ul><li> size of '||asize||' creation data of '||info||'</li></ul>'||'0d0a'x
      end
      else do
        stuff='OK : session descriptor file deleted: <ul><li> size of '||asize||' creation data of '||info||'</li></ul>'||'0d0a'x
      end

      if (fake<>1) then do                              /* really do it? */
         ares=sysfiledelete(dafile)
         if (ares<>0) then do
            stuff='ERROR: unable to delete session descriptor file. Error='||dafile||') : ' ||errcodes.ares
         end 
      end
      rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
      return rcode
   end

   if (step=2) then do          /* step 2: kill session parameter etc files (in sessions/sessname */
      dafiles=sessions_dir||'\'||sessname||'\*'
      info=sysfiletree(dafiles,'fdone.','FOS')                  /* also kill files in \BACKUP */

/* assume fake ... */
      tmp=''
      if fdone.0>0 then tmp='<menu>'||'0d0a'x
      do m=1 to fdone.0
         tmp=tmp||' <li> '||filespec('N',fdone.m)||'</li>'||'0d0a'x
      end 
      if fdone.0>0 then  tmp=tmp||'</menu>'||'0d0a'x
      stuff='OK : '||fdone.0||' parameter files would be x deleted: '||tmp

      if (fake<>1) then do                              /* really do it? */
         iserr=0
         tmp='<menu>'||'0d0a'x
         do m=1 to fdone.0
           ares=sysfiledelete(fdone.m)
           if (ares<>0) then iserr=1
           tmp=tmp||' <li> '||filespec('N',fdone.m)||': '||errcodes.ares||'</li>'||'0d0a'x
         end

         adir=sessions_dir||'\'||sessname||'\BACKUP'              /* now remove BACKUP directory */
         ares=sysRmDir(adir);
         if (ares<>0) then iserr=1
         tmp=tmp||' <li> <em>removing backup directory   '||adir||': '||derrcodes.ares||'</li>'||'0d0a'x
 
         adir=sessions_dir||'\'||sessname               /* now remove directory */
         ares=sysRmDir(adir);
         if (ares<>0) then iserr=1
         tmp=tmp||' <li> <em>removing directory   '||adir||': '||derrcodes.ares||'</li>'||'0d0a'x
         
         tmp=tmp||'</menu>'||'0d0a'x
         if (iserr=1) then do
            stuff='ERROR : problem deleting a parameter file (or  directory).'||'0d0a'x||tmp
         end
         else do
             stuff='OK : '||fdone.0||' parameter files deleted: '||'0d0a'x||tmp
         end
      end                              /* not fake */

      rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
      return rcode
   end

   if (step=3) then do          /* step 3: kill session temporary files (in data/sessname */
      dafiles=data_dir||'\'||sessname||'\*'
      info=sysfiletree(dafiles,'fdone.','FO')

/* assume fake */
      tmp=''
      if fdone.0>0 then  tmp='<menu>'||'0d0a'x
      do m=1 to fdone.0
         tmp=tmp||' <li> '||filespec('N',fdone.m)||'</li>'||'0d0a'x
      end 
      if fdone.0>0 then  tmp=tmp||'</menu>'||'0d0a'x
      stuff='OK : '||fdone.0||' temporary files would be deleted: '||tmp

      if (fake<>1) then do                              /* really do it? */
         iserr=0
         tmp='<menu>'||'0d0a'x
         do m=1 to fdone.0
           ares=sysfiledelete(fdone.m)
           if (ares<>0) then iserr=1
           tmp=tmp||' <li> '||filespec('N',fdone.m)||': '||errcodes.ares||'</li>'||'0d0a'x
         end
         adir=data_dir||'\'||sessname                   /* now remove directory */
         ares=sysRmDir(adir);
         if (ares<>0) then iserr=1
         tmp=tmp||' <li> <em>removing directory   '||adir||': '||derrcodes.ares||'</li>'||'0d0a'x

         tmp=tmp||'</menu>'||'0d0a'x
         if (iserr=1) then do
            stuff='ERROR : problem deleting a temporary data file (or the directory).'||'0d0a'x||tmp
         end
         else do
             stuff='OK : '||fdone.0||' temporary data files deleted: '||'0d0a'x||tmp
         end
       end                              /* not fake */

      rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
      return rcode
   end

   if (step=4) then do          /* step 3: kill session client-accessible files (in pinfo/essname */
      dafiles=lookup_dir||'\'||sessname||'\*'
      info=sysfiletree(dafiles,'fdone.','FO')

/* assume fake */
      tmp=''
      if fdone.0>0 then  tmp='<menu>'||'0d0a'x
      do m=1 to fdone.0
         tmp=tmp||' <li> '||filespec('N',fdone.m)||'</li>'||'0d0a'x
      end 
      if fdone.0>0 then  tmp=tmp||'</menu>'||'0d0a'x
      stuff='OK : '||fdone.0||' client-accessible files would be  deleted: '||tmp

      if (fake<>1  ) then do                              /* really do it? */
         iserr=0
         tmp='<menu>'||'0d0a'x
         do m=1 to fdone.0
           ares=sysfiledelete(fdone.m)
          if (ares<>0) then iserr=1
         tmp=tmp||' <li> '||filespec('N',fdone.m)||': '||errcodes.ares||'</li>'||'0d0a'x
         end

/* now remove directory */
         adir=lookup_dir||'\'||sessname
         ares=sysRmDir(adir);
         if (ares<>0) then iserr=1
         tmp=tmp||' <li> <em>removing directory   '||adir||': '||derrcodes.ares||'</li>'||'0d0a'x

         tmp=tmp||'</menu>'||'0d0a'x
         if (iserr=1) then do
            stuff='ERROR : problem deleting a client-accesible  file (or the directory).'||'0d0a'x||tmp
         end
         else do
             stuff='OK : '||fdone.0||' client-accesible files deleted: '||'0d0a'x||tmp
         end
       end                              /* not fake */


      rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
      return rcode
   end

  call sre_pmprintf('Error in kill session: bad step ='||step)
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ','ERROR: no such step '||step,stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode
 
end


/* email message via smtp gateway */
if optname.!TODO=560 then do    

/* read smtp parameters from svydir/smtpParams.txt. These must be set by web server manager (i.e.
   when dsurvey is installed*/
   dafile=svydir||'\smtpParams.txt'
   astuff=sre_read_file(dafile,2,3,1)
   astuff=strip(astuff)

   smtpGateway='0'
   smtpName=''
   smtpPwd=''
   tss=translate(servername)
   if left(tss,3)='WWW' then tss=substr(servername,5)
   defaultFrom='admin@'||servername
   do while astuff<> ""
     parse var astuff aline '0d0a'x astuff

     aline=strip(aline)
     if aline='' then iterate
     if left(aline,1)=';' then iterate        /* skip comments */
     parse var aline aword avalue .             
        aword=strip(translate(aword))
        if aword='GATEWAY' then do
           smtpGateway=strip(avalue)
        end 
        if (aword='USER' | aword='USERNAME') then do 
           avalue=strip(avalue)
           if (avalue<>'' & avalue<>'0') then    smtpName=avalue

        end 
        if (aword='PASSWORD' | aword='PWD')  then do 
           avalue=strip(avalue)
           if (avalue<>'' & avalue<>'0') then    smtpPwd=avalue
        end 
        if (aword='FROM' | aword='DEFAULTFROM' | aword='DEFAULT_FROM') then do
           avalue=strip(avalue)
           if (avalue<>'' & avalue<>'0') then  defaultFrom=avalue
        end 
/* all other words are ignored */
   end


   stuff=''
   test=strip(optname.!test)
   if test='1' then do                    /* return smtpParams */
      stuff='SMTP parameters (saved in '||dafile||')'||'0d0a'x 
      stuff=stuff||' * GATEWAY = ' || smtpGateway||'0d0a'x 
      stuff=stuff||' * USER = ' || smtpName||'0d0a'x 
      stuff=stuff||' * PASSWORD = ' || smtpPwd||'0d0a'x 
      stuff=stuff||' * DEFAULT_FROM = ' || defaultFrom||'0d0a'x 
      rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
      return rcode
   end /* do */

   if (smtpGateway='0') then do
        stuff='- Error: no smtp_gateway specified (administrative action required)'
        rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
        return rcode
   end /* do */
 


/* Note that smtpName and smtpPwd are often required, but are not always required. So it is not an error
   if the aren't specified in smtpParams.txt
*/

   sessname=strip(optname.!session)
   subject=strip(sre_packur(optname.!subject))

   message=strip(sre_packur(optname.!message))
   sendto=strip(sre_packur(optname.!sendto))
   sendfrom=strip(sre_packur(optname.!sendfrom))
     if (sendfrom=='') then sendfrom=defaultFrom

   message2=subject||'0d0a'x||message

   foo=dsvyMailit(sendto,message2,smtpGateway,sendfrom,smtpName,smtpPwd,0)
 
   if foo='1' then astat='ok'
   if (foo<>'1') then astat=" - Email error: "||foo
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',astat,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
   return rcode
end
   

if optname.!TODO=601 then do              /* suspend session specific files */
   sessname=strip(optname.!session)
   dafile=sessions_dir||'\'||sessname||'.XML'
   newfile=sessions_dir||'\'||sessname||'.SUSPEND_XML'
   res=dosrename(dafile,newfile)
   if (res=1) then 
        stuff=  'Session sucessfully <b>suspended</b> (session descriptor file renamed to '||newfile||')'
   else 
        stuff='Error: unable to suspend session (not able to rename '||dafile||')'
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode
end

if optname.!TODO=602 then do              /* suspend session specific files */
   sessname=strip(optname.!session)
   dafile=sessions_dir||'\'||sessname||'.SUSPEND_XML'
   newfile=sessions_dir||'\'||sessname||'.XML'
   res=dosrename(dafile,newfile)
   if (res=1) then 
        stuff=  'Session sucessfully <b>UNsuspended</b> (session descriptor file reset to '||newfile||')'
   else 
        stuff='<b>Error:</b> unable to suspend session (not able to rename '||dafile||')'
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT ',stuff,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode
end

if optname.!TODO=711 then do              /* add a note */
   sessname=strip(sre_packur(optname.!session))
   acontent=strip(sre_packur(optname.!content))
   bFile=sessions_dir||'\'||sessname||'\notes.txt'
   if strip(acontent)<>'' then do
     acontent='---------------- '||'0d0a'x||acontent||'0d0a'x
      foo=sre_append_file(bFile,acontent,5,1,0)
   end
  stuff=sre_read_file(bfile,2,3,1) 
   
   rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',stuff,idinfo,,'Content-Type: text/plain') 
   return rcode
end

if optname.!TODO=801 then do              /* create list of currently active sessions */
  instfiles=sessions_dir||'\*.xml'
  goo=sysfiletree(instfiles,'alist','f')
  aa=''
  do mm=1 to alist.0 
      aa=aa||' '||filespec('n',alist.mm)
  end
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',aa,idinfo,,'Content-Type: text/plain') 
  return rcode
end

if optname.!TODO=802 then do              /* save file to /dsurvey/dsurvey.htm */
     afile=wwwdir||'\dsurvey.htm'
     vval=sre_packur(optname.!contents)
     istat=sre_append_file(afile,vval,3,0,1)
     amess=append_File_Error(istat,afile,'')
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',amess,idinfo,,'Content-Type: text/plain') 
     return rcode
end

/* retrieve list of scenario files. If instName specified, from instruments directory. Otherwise, from sessions directory */
if optname.!TODO=901 then do              

  if (optname.!instrument<>'') then do
      instfiles=instruments_dir||'\'||optname.!instrument||'\SC_*.xml'
  end 
  else do
    sessname=optname.!session
    instfiles=sessions_dir||'\'||sessname||'\SC_*.xml' 
  end
  goo=sysfiletree(instfiles,'alist','f')
  aa=''
 do mm=1 to alist.0 
      aa=aa||' '||filespec('n',alist.mm)
 end

 rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',aa,idinfo,,'Content-Type: text/plain') 
 return rcode

end


/* retrieve list of scenarioList files. If instName specified, from instruments directory. Otherwise, from sessions directory */
if optname.!TODO=9011 then do              

  if (optname.!instrument<>'') then do
      instfiles=instruments_dir||'\'||optname.!instrument||'\SL_*.xml'
  end 
  else do
    sessname=optname.!session
    instfiles=sessions_dir||'\'||sessname||'\SL_*.xml' 
  end
  goo=sysfiletree(instfiles,'alist','f')
  aa=''
 do mm=1 to alist.0 
      aa=aa||' '||filespec('n',alist.mm)
 end

 rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',aa,idinfo,,'Content-Type: text/plain') 
 return rcode

end


call sre_pmprintf("Error: unknown todo="||optname.!todo)

svyerr:
call pmprintf(' an error in dsurvey.cmd. '||sigl||' Condition: ' ||condition('C')||' and ' || condition('D'))
return 0


/******************/
/* read a multipart/form-data type of submission 
(that a web browser could submit when responding to a form
with an action of POST and an enctype of "multipart/form-data")

syntax:
   astatus=parse_multipart(post_body)
where post_body is the body of the POST response (from the browser)

Data is returned in the OPTNAME. stem variable (which is exposed)

  optname.0 =space delimited  list of variable names
  optname.!varname = contents of the "varname" variable (varname is one of the words
                     stored in varname.0). This might be a file contents.
  optname.!varname.!filename = if the contents are due to submission of a file,
                               this contains the name of the file (as supplied by
                               the browser). Otherwise, it is blank
  optname.!varname.!CONTENT_TYPE = if the contents are due to submission of a file,
                                   this contains the content-type. If no content-type
                                   was specified, this will be text/plain.
                                   If NOT due to a file submission, this is blank.

Astatus contains status info:
  0 = Success
  1 = Not a multipart/form-data 
  2 = No multipart/form-data in content-type 
  3 = No boundary 
  4 = No data recieved 


*/
parse_multipart:procedure expose optname.
parse arg abody

crlf='0d0a'x
rept=''

optname.=''

/*get content type request header */
atype=sre_reqfield('content-type')

/*typical value of atype
      multipart/form-data; boundary=---------------------------309151678928465
*/

/* is there a content-type request header ? */
if atype="" then do
    return 1
end

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

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

if strip(translate(thetype))<>"MULTIPART/FORM-DATA" then do
   return 2
end

if abound="" then do
   return 3
end

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

abd1=crlf||abound
abd2=abound

/* A multi-part submission typically has the following structure:

   Content-Type: multipart/form-data; boundary=AaB03x

   --AaB03x
   Content-Disposition: form-data; name="personal_name"

   Larry
   --AaB03x
   Content-Disposition: form-data; name="myfile"; filename="file1.txt"
   Content-Type: text/plain

   ... contents of file1.txt ...
   --AaB03x--

  Thus, processing works by:
   a) pull out a block, where blocks are defined by "boundary strings"
   b) for each block, pull out the headers, where the headers end at the first
      blank line
   c) the contents is everything remaining in the block, after this empty line
   
  There are two important headers, the content-disposition and content-type.
  If the content-disposition contains a  filename="xx" field, then this block
  contains a FILE upload. Otherwise, this block contains the value of a regular form
  field (such as an <INPUT type="TEXT" var="personal_name"> element)

  The content-type is sometimes also sent by the browser.
 
*/

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

  varname=''
  filename=''
  ctype=''

/* we have a "block", as delimited by the boundary string. */

  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 */
         parse var anarg ahd ':' anarg
         ahd=strip(translate(ahd))
         select
            when ahd='CONTENT-TYPE' then do
                ctype=strip(anarg)
            end 
            otherwise do                /* strip out arguments */
               do until anarg=''
                  parse var anarg anarg1 ';' anarg
                  if pos('=',anarg1)='' then iterate
                  parse var anarg1 cvar '=' cval
                  cval2=strip(strip(cval),,'"')
                  cvar=strip(translate(cvar))
                  select               
                    when cvar="NAME" then varname=strip(translate(cval2))          /* name of this block */
                    when cvar="FILENAME" then filename=strip(cval2)   /* original file name */
                    when cvar="CONTENT-TYPE" then strip(cval2)        /* some browsers might send this here */
                    otherwise nop               /* ignore other arguments */
                  end           /* select */
               end     /* extract arguments */
            end        /* otherwise */
         end            /* select */
     end                /* else do*/
   end                    /* get a line */

/* when here, got a block's headers. The rest is the content of the block (i.e.;
   the value of a variable */
  if varname='' then iterate            /* no name, so ignore */
  vv=strip(translate(varname))
  optname.0=optname.0||' '||vv
  vv1='!'||vv
  optname.vv1=thestuff
  optname.vv1.!filename=translate(filename)
  optname.vv1.!!FIlename=filename
  if filename<>'' & ctype='' then ctype='text/plain'
  if filename<>'' then optname.vv1.!content_type=ctype

end             /* back to top to get the next block */


if mm=0 then do
     return 4
end


return 0



append_File_Error:procedure
parse arg istat,afile,okmessage
   
   if (istat=-1) then do 
        amess='-  Error:  could not open file '||filespec('n',afile)
        return amess
   end
   if (istat=-2) then do 
         amess='-    problem writing to file '||filespec('n',afile)
        return amess
   end
   if (istat=-3) then do 
         amess='-   unable to delete existing file '||filespec('n',afile)
        return amess
   end
   return 'ok.  '||okmessage


/* =============== smtp mail procedure ===== */

/* ============================================================================ 
dsvyMailit: A  REXX procedure to mail a note to several recipients.
 
   Called as:  status=dsvyMailit(address_list,message_string,smtp_gateway,optional_senders_address,
                                 sender_name,sender_password,verbose)
 
  address_list: A space delimited list of addresses
  message_string: A message string, that may contain CRLFs (and may be rather long)
  smtp_gateway: The address of your SMTP server 
  optional_senders_address: The sender's address (optional)
         If sender's address is not given, it will be generated using the servername() function.
  sender_name and sender_password: used for authentication
 
  Example:
  status=mailit("BOB@HIS.NET" , "This is my message ", "MAIL.MY.ORG",'me1@my.org','me','pwd1',2 )
 
Status:
   0 error message - a problem
   1  - success 

    
  Note on recipient addresses:
     The message will be sent to each address.  Since the addresses are
     sent and then the message, this allows for fairly rapid mailing to multiple
     individuals.
 
 Acknowledgment:
      This is a modification of a routine written by Dave Briccetti     daveb@davebsoft.com, http://www.davebsoft.com
      It has been modified by Daniel Hellerstein (last revision March 2011)
     
 
============================================================================ */

dsvyMailit:procedure 
parse arg whotos , themessage  , smtpaddress ,  sender_address, sender_name, sender_password,verbose

err_message=''

smtpaddress=strip(smtpaddress)
sender_address=strip(sender_address)

/* set some constants */
CRLF                    = '0d0a'x
TRUE                    = 1
FALSE                   = 0
REPLYTYPE_OK            = '2'   /* SMTP reply code first byte */
REPLY_START_MAIL_INPUT  = '354' /* SMTP reply code */

if sender_address="" then do
   sendinghost=sre_servername()
   sendinguser="WebServer"
   sender_address=sendinguser||'@'||sendinghost
end
 
MailServer  = smtpaddress  /* Mail server, leave blank if you are connected through a LAN */

if \RxFuncQuery("SockLoadFuncs") then do 
   nop
end 
else do
   call RxFuncAdd "SockLoadFuncs","rxSock","SockLoadFuncs"
   call SockLoadFuncs
end

if EstablishProtocol() = FALSE then do
    err_message=err_message||' || protocol could not be established'
    if verbose>1 then do
        call sre_pmprintf('#MailIt: protocol could not be established')
    end 
    return 0||' '||err_message
end 

/* The protocol initiated, we'll now send the message to each
   recipient */
isgood=1
call SendMsgToEachRecipient
/* QUIT ends the protocol */
 
CmdReply = TransactSmtpCommand(socket, 'QUIT')

/* Close the socket */
    
call SockSoClose socket
if isgood=1 then err_message=''
return isgood||' '||err_message



/* ========================================================================= */
EstablishProtocol:
/* ========================================================================= */

socket = ConnectToMailServer(MailServer)    
if socket <= 0 then do
    err_message=err_message||' || Could not connect to mail server: 'socket
    if verbose>0 then do
      call sre_pmprintf( '#MailIt. Could not connect to mail server: 'socket)
    end
    return FALSE
end

CmdReply = GetCmdReply(socket)

if left(CmdReply, 1) \= REPLYTYPE_OK then do
    rrr=space(translate(cmdreply,' ','0d0a09'x))
    err_message=err_message||' || Could not establish protocol: 'rrr
    if verbose>0 then  do
       call sre_pmprintf( '#MailIt: Could not establish protocol: 'rrr)
    end
    return FALSE
end


/* Send the extended hello, in case this SMTP server supports
   SMTP extensions */
        
CmdReply = TransactSmtpCommand(socket, 'EHLO '||smtpaddress)
SizeExtensionSupported = 0
simpleAuthSupported=0
        
if left(CmdReply, 1) = REPLYTYPE_OK then do
    /* That worked, so enable extended SMTP processing.  If
       the response to the EHLO indicates support for SIZE,
       enable our use of that feature */
              
    SmtpExtensionsSupported = TRUE
    if pos('250 SIZE', CmdReply) > 0 | pos('250-SIZE', CmdReply) > 0 then
        SizeExtensionSupported = 1

/* and check for auth login */
    if pos('AUTH PLAIN ', CmdReply) > 0 | pos('AUTH=PLAIN ', CmdReply) > 0 then
        simpleAuthSupported = 1


end
else do
    /* The server didn't recognize the EHLO so we'll go with
       the regular HELO */
    rrr=space(translate(cmdreply,' ','0d0a09'x))
    err_message=err_message||' || EHLO not recognized:' rrr 
    if verbose>1 then do
        call sre_pmprintf("#MailIt: EHLO not recognized:" rrr)
    end
    SmtpExtensionsSupported = FALSE
    SizeExtensionSupported  = FALSE
    CmdReply = TransactSmtpCommand(socket, 'HELO '||smtpaddress)

end
if left(CmdReply, 1) = REPLYTYPE_OK then  do
    return TRUE
end
else do
   rrr=space(translate(cmdreply,' ','0d0a09'x))
   err_message=err_message||' || HELO not recognized:' rrr 
    if verbose>1 then do
       call sre_pmprintf("#MailIt: HELO not recognized:" rrr)
    end
    return FALSE
end


/* ========================================================================= */
SendMsgBody: 
/* ========================================================================= */

/* DATA tells the server that the body of the message is coming.  It
   should reply with a code meaning "go ahead." */

CmdReply = TransactSmtpCommand(socket, 'DATA')
if substr(CmdReply, 1, 3) = REPLY_START_MAIL_INPUT then do
    /* Send the data, followed by a '.' on a line by itself to 
       indicate the end of the message */
    rrr=translate(cmdreply,' ','0d0a09'x)
    if verbose>2 then call sre_pmprintf('MailIt. Okay on DATA: 'rrr)
    CmdReply = TransactSmtpCommand(socket, MsgFileContents || CRLF || '.',1)
    rrr=translate(cmdreply,' ','0d0a09'x)
    if verbose>2 then call sre_pmprintf('MailIt. Okay on DATA body: 'rrr)
end
else do
   rrr=space(translate(cmdreply,' ','0d0a09'x))
   err_message=err_message||' || Problem on DATA: 'rrr
   if verbose>2 then do
      call sre_pmprintf('#MailIt. Problem on DATA: 'rrr)
   end
   isgood=0
end

return


/* ========================================================================= */
SendMsgToEachRecipient:
/* ========================================================================= */


/* send an AUTH */
if simpleAuthSupported=1 then do
  anauth=MKPACK64('00'x||sender_name||'00'x||sender_password)
  CmdReply = TransactSmtpCommand(socket, 'AUTH PLAIN '||anauth)
  cmdReply=strip(cmdreply)
  if left(cmdReply,1)<>'2' then do
       isgood=0
       err_message=cmdReply
       return 
   end

end

msgfilecontents=themessage
MsgFileContents = strip(MsgFileContents, 't', '1a'x) 
        
/* MAIL FROM identifies the sender.  The SIZE= extension
   provides the size of the message, to allow the 
   server to quickly refuse messages bigger than it wants. */

/* Note : many smtp gateways only accept mail from a limited set
          of domains. Make sure the domain portion of sender_address
          is one of these  */
           
MailFromCmd = 'MAIL FROM:' ||sender_address

if SizeExtensionSupported then
    MailFromCmd = MailFromCmd ' SIZE=' || length(MsgFileContents)
    
CmdReply = TransactSmtpCommand(socket, MailFromCmd)
if left(CmdReply, 1) = REPLYTYPE_OK then do
  whotos=translate(whotos,' ','000d0a1a09'x)
  do while whotos<> ""
     parse var whotos whoto whotos
     RecipientEmailAddress = strip(whoto)
     if RecipientEmailAddress \= '' then do   /* RCPT identifies the intended recipient of the message */
         CmdReply = TransactSmtpCommand(socket,,
                         "RCPT TO:" || RecipientEmailAddress)
        if verbose>2 then do
          rrr=space(translate(cmdreply,' ','0d0a09'x))
          call sre_pmprintf("MailIt: RCPT TO: response is "rrr)
        end
     end
  end 
  call SendMsgBody
end
else do
  if verbose>1 then do
     rrr=space(translate(cmdreply,' ','0d0a09'x))
     call pmprintf("#MailIt: MAIL FROM rejected: " rrr)
  end
  isgood=0
end
return


/* ========================================================================= */
ConnectToMailServer: procedure expose verbose isgood err_message ehlopause
/* ========================================================================= */

parse arg MailServer
socket = 0
ehlopause=1    /*  1=add a pause on EHLO requests -- some smtp servers need this */

/* Open a socket to the mail server.  (The Sock* functions are
   documented in the REXX Socket book in the Information folder
   in the OS/2 System folder */

call SockInit
if SockGetHostByName(MailServer, 'host.!') = 0 then do
    err_message=err_message||'  Could not get host by name' errno' ' h_errno
    if verbose>0 then do
         call sre_pmprintf('#MailIt. Could not get host by name' errno' ' h_errno)
    end
end
else do
    socket = SockSocket('AF_INET','SOCK_STREAM',0)
    address.!family = 'AF_INET'
    address.!port = 25          /* the standard SMTP port */
    address.!addr = host.!addr
    if SockConnect(socket, 'address.!') = -1 then  do
      err_message=err_message||'   Could not connect socket' errno' ' h_errno
      if verbose>0 then do
         call sre_pmprintf( '#MailIt. Could not connect socket' errno' ' h_errno)
      end
    end
end
return socket


/* ========================================================================= */
GetCmdReply: procedure expose verbose  isgood err_message
/* ========================================================================= */

parse arg socket

CRLF = '0d0a'x

/* Receive the response to the SMTP command into a variable.  Use
   more than one socket read if necessary to collect the whole 
   response. */
if SockRecv(socket, 'CmdReply', 200) < 0 then do
    err_message=err_message||' Error reading from socket' errno' ' h_errno
    if verbose>0 then  do
       call sre_pmprintf('#MailIt. Error reading from socket' errno' ' h_errno)
    end
    exit 0
end
ReadCount = 1
MaxParts = 10

do while ReadCount < MaxParts & right(CmdReply, 2) \= CRLF  
    if SockRecv(socket, 'CmdReplyExtra', 200) < 0 then do
        if verbose>0 then  do
           call sre_pmprintf('#MailIt. Error reading from socket')
        end
        exit 0
    end
    CmdReply = CmdReply || CmdReplyExtra
    ReadCount = ReadCount + 1
end
/* a=sre_pmprintf(cmdReply,1) */
return CmdReply


/* ========================================================================= */
TransactSmtpCommand: 
/* ========================================================================= */

parse arg socket, Cmd,noverbose

/* Send a command to the SMTP server, echoing it to the display
   if requested */

if verbose>1  & noverbose<>1 then  call sre_pmprintf(" Command is "  Cmd)
rc = SockSend(socket, Cmd || CRLF)

if ehlopause=1 then do
  If (Pos('EHLO', Cmd) <> 0) Then Call SysSleep 1
end

op=GetCmdReply(socket)

return op



/* create a base64 packing of a message */
MKPACK64:procedure 
parse arg mess

biga=xrange('A','Z')||xrange('a','z')||xrange('0','9')||'+/'

s2=x2b(c2x(mess))

nith=trunc((length(s2)/6)+.9)
cont=copies(' ',nith)
oof=""
do mm=0 to 63
      oof=oof||x2c(b2x(right('00'||x2b(d2x(mm)),6)))
end /* do */
do ith=1 to nith 
  a1=substr(s2,(ith*6)-5,6,0)
  cont=overlay(x2c(b2x(a1)),cont,ith) 
end /* do */
pint=""
pint=translate(cont,biga,oof)
j1=length(pint)//4
if j1<>0 then pint=pint||copies('=',4-j1)
return pint







