/* server side component of the dsurvey "instrument setup" utilities */

/* TODO determines the action.
1       return space delimited list of instruments. Uses the  xml files in /dsurvey/instruments directory 
2       create instrument descriptor file
21       create instrument descriptor file
3       create instrument directories
5       copy template from (From ... to )
6       modify allowedUsers file (for a session). IF error, return message starts with a "-"
56      return space delimited list of XML files in /dsurvey/admins/customJoin
61       modify reference data file (for an instrument). IF error, return message starts with a "-"
62       modify reference data file (for a session). IF error, return message starts with a "-"
71       modify general data file (for an instrument). IF error, return message starts with a "-"
72       modify general data file (for an session). If error  return message starts with a "-"
76       write instrument specific XML parameter files  (that may have been modified).
721      save scenario data (for a session) If error  return message starts with a "-"
81      delete an instrument
91       modify documentation file (for an instrument). IF error, return message starts with a "-"
921     return list of files in a instrument's spec and modules file, relative to the instrument directory
923     delete an instrument's spec or module file, relative to the instrument directory
925     restore backup file to its original file name (overwrites current version): &name=instname&file=afile&dest=origfile;

*/



/******** User changeable parameters ***/
/* 
 svydir: root directory for the SREhttp/2 dSurvey 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 site's 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

  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 '

copycodes.='Copy error '
copycodes.2='source file not found'
copycodes.3='soure or target path not found'
copycodes.32='sharing violation for source or target file';
copycodes.108='drive locked'
copycodes.112='disk full'


/* 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
   admins_dir: root of the administrative files directory.
---------------------------------------     */

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


admins_dir=wwwdir||'\admins'
okk=dosisdir(admins_dir)
if okk=0 then do
  return 'string unable to find ADMINS directory: ' admins_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.=''

/* zcall=sre_pmprintf(' content= '||left(list,600),1);  */
 
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

/* ==== START THE ACTIOSN ========== */
/* ==== START THE ACTIOSN ========== */
/* ==== START THE ACTIOSN ========== */

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=2  then do              /* create instrument descriptor file*/
  if optname.!FILE='' then do
     call sre_pmprintf(' Error in dSurveySetup: no FILE when todo=2 ');
     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=instruments_dir||'\'||optname.!FILE

  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)
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode

end


if optname.!TODO=21  then do              /* create instrument descriptor file*/
  if optname.!FILE='' then do
     call sre_pmprintf(' Error in dSurveySetup: no FILE when todo=21 ');
     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.!FILE

  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)
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode


end


if optname.!TODO=3  then do              /* create diorectdories */

  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no NAME when todo=3 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 No NAME field',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  baseDir=instruments_dir||'\'||optname.!NAME

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

  made1='Ok. Directories created: '||basedir||', ' 

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

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

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

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

  return rcode
end  


if optname.!TODO=5  then do              /* copy template file FROM .... TO */

  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no NAME when todo=5 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 No NAME field',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  baseDir=instruments_dir||'\'||optname.!NAME /* root directory of this instrument */
  toDir=baseDir||optname.!TODIR
  
  fromDir=wwwdir||'\'||optname.!FROMDIR

  filelist=optname.!filelist
   do until filelist='' ;
       parse var filelist afile ',' filelist
       parse var afile afile1 '=' afile2 . 
       if afile2='' then afile2=afile1
       fromfile=fromDIR||strip(afile1)
       tofile=toDir||strip(afile2)
       cresult=dosCopy(fromfile,tofile,'R')
       if (cresult<>0) then do
           rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 ('||cresult||'). Unable to copy '||fromfile,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
           return rcode
       end
  end        
  made1='Ok. Success copying files: '||optname.!filelist
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',made1,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode
end


if optname.!TODO=6  then do              /* modify session specific allowedUsers file */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no name when todo=6 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no name','Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  newFile=sessions_dir||'\'||optname.!NAME||'\allowedUsers.xml'

  stuff=sre_packur(optname.!content)  /* note: always overwrite */
  foo=sre_append_file(newFile,stuff,3,0,1)
  if substr(foo,1,1)='-' then do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  else do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  return rcode

end


if optname.!TODO=56 then do              /* new session -- get list of .xml files in /dsurvey/admins/customJoin directory */
  instfiles=admins_dir||'\customJoin\*.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=61  then do              /* modify instrument specific reference data file */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no name when todo=61 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no name','Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  newFile=instruments_dir||'\'||optname.!NAME||'\reference.xml'

  stuff=sre_packur(optname.!content)  /* note: always overwrite */
  foo=sre_append_file(newFile,stuff,3,0,1)                              /* if problem, return message starts with - */
  if substr(foo,1,1)='-' then do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  else do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  return rcode

end


if optname.!TODO=62  then do              /* modify ession specific reference data file */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no name when todo=62 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no name',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  newFile=sessions_dir||'\'||optname.!NAME||'\reference.xml'

  stuff=sre_packur(optname.!content)  /* note: always overwrite */
  foo=sre_append_file(newFile,stuff,3,0,1)                              /* if problem, return message starts with - */
  if substr(foo,1,1)='-' then do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  else do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  return rcode

end


if optname.!TODO=71  then do              /* modify instrument specific general data file */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no name when todo=71 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no name','Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  newFile=instruments_dir||'\'||optname.!NAME||'\params.xml'

  stuff=sre_packur(optname.!content)  /* note: always overwrite */
  foo=sre_append_file(newFile,stuff,3,0,1)                              /* if problem, return message starts with - */
  if substr(foo,1,1)='-' then do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  else do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  return rcode

end


if optname.!TODO=72  then do              /* modify ession specific general data file */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no name when todo=72 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no name',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  newFile=sessions_dir||'\'||optname.!NAME||'\params.xml'

  stuff=sre_packur(optname.!content)  /* note: always overwrite */
  foo=sre_append_file(newFile,stuff,3,0,1)                              /* if problem, return message starts with - */
  if substr(foo,1,1)='-' then do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  else do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  return rcode

end


if optname.!TODO=76 then do              /*  write (or overwrite) a parameter file for an instrument (an XML file) */

/*  parse var stuff insts '0d0a'x stuff */

  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: 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
  if pos('/',optname.!FILE)=1 then do   
     thefile=strip(sre_dataDir())||translate(optname.!FILE,'\','/')
  end 
  else do
    thisDir=instruments_dir||'\'||optname.!NAME||'\'
    thefile=thisdir||optname.!FILE
  end
/* save space: post does NOT packur the content (puts is on 2nd line) */
  parse var list0 x '0a'x stuff 
/*  stuff=optname.!content  */
  foo=sre_append_file(theFile,stuff,3,0,1)
/* call pmprintf("saving "||thefile) */
  amess=append_File_Error(foo,thefile,'Saving file: '||thefile)
  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=721  then do              /* save scenario data for a session */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no name when todo=721 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no name',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  if optname.!SCNAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no scname when todo=721 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no scenario name',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end

  newFile=sessions_dir||'\'||optname.!NAME||'\'||optname.!scName||'.xml'

  stuff=sre_packur(optname.!content)  /* note: always overwrite */
  foo=sre_append_file(newFile,stuff,3,0,1)                              /* if problem, return message starts with - */
  if substr(foo,1,1)='-' then do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  else do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  return rcode

end


if optname.!TODO=81  then do              /* delete an instrument */

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

 astat='Deleted files:'

  instFile=instruments_dir||'\'||optname.!NAME||'.xml'
  if stream(instfile,'c','query exists')<>'' then do
     foo=sysfiledelete(instFile);
     if foo<>0 then do
        rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Unable to delete descriptor file: '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
        return rcode
     end
     astat=astat||' '||instfile
   end

  aa=sysFileTree(instruments_dir||'\'||optname.!NAME||'\*.*','flist','FSO');

  do m= 1 to  flist.0
      afile=flist.m
      foo=sysfiledelete(afile)
      if foo<>0 then do
         rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Unable to delete  file '||afile||' :: '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
         return rcode
      end
      astat=astat||' '||afile
  end 

/* now delete directories */
  aa=sysFileTree(instruments_dir||'\'||optname.!NAME||'\*.*','flist','DSO');
  do m=1 to flist.0
      afile=flist.m
      foo=sysRmDir(afile)
      if foo<>0 then do
         rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Unable to delete  directory '||afile||' :: '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
         return rcode
      end
      astat=astat||' '||afile
  end 

/* and the root directory for this instrument ... */
 afile=instruments_dir||'\'||optname.!NAME
 foo=sysRmDir(afile)
 if foo<>0 then do
         rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Unable to delete instrument root directory '||afile||' :: '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
        return rcode
 end
   
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||astat,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode

end


if optname.!TODO=91  then do              /* modify instrument specific documentaiton text file */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no name when todo=91 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no name','Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  newFile=instruments_dir||'\'||optname.!NAME||'\describe.txt'

  stuff=sre_packur(optname.!content)  /* note: always overwrite */
  foo=sre_append_file(newFile,stuff,3,0,1)                              /* if problem, return message starts with - */
  if substr(foo,1,1)='-' then do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ',foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  else do
    rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Ok. '||foo,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  end
  return rcode

end


if optname.!TODO=921  then do              /* return list of instrument files */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no name when todo=921 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no name',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  aext=optname.!EXT 

  aa=''
  igot=0
  if aext<>'' then
    getem=instruments_dir||'\'||optname.!NAME||'\specs\*.'||aext
  else
    getem=instruments_dir||'\'||optname.!NAME||'\specs\*'
  goo=sysfiletree(getem,'alist','fo')
  
   do mm=1 to alist.0 
      aa=aa||' specs/'||filespec('n',alist.mm)
      igot=igot+1
   end

  if aext<>'' then
    getem=instruments_dir||'\'||optname.!NAME||'\modules\*.'||aext
  else
    getem=instruments_dir||'\'||optname.!NAME||'\modules\*'
  goo=sysfiletree(getem,'alist','fo')
  
   do mm=1 to alist.0 
      aa=aa||' modules/'||filespec('n',alist.mm)
      igot=igot+1
   end

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

end


if optname.!TODO=923  then do                   /* delete an instrument file, or files */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no name when todo=923 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no name',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  idir=strip(optname.!NAME)
  flist=strip(optname.!file)
  flist=strip(sre_packur(translate(flist,' ','+')))
  astat=''

  do m=1 to words(flist)  
     afile=word(flist,m)
     getem=instruments_dir||'\'||idir||'\'||afile
     foo=sysfiledelete(getem)
     if foo<>0 then do
       astat=astat||'Unable to delete file ('||errcodes.foo||'):'||afile||'0d0a'x
     end 
     else do
       astat=astat||'File deleted: '||afile||'0d0a'x
     end
  end
  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=925  then do                   /* restore an instrument file */
  if optname.!NAME='' then do
     call sre_pmprintf(' Error in dSurveySetup: no name when todo=925 ');
     rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','-1 syntax error, no name',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
     return rcode
  end
  fromf=instruments_dir||'\'||optname.!NAME||'\'||optname.!FILE
  tof=instruments_dir||'\'||optname.!NAME||'\'||optname.!DEST
  cresult=dosCopy(fromf,tof,'R')
  if (cresult<>0) then do
             rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Unable to restore backup: '||copycodes.cresult,idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
             return rcode
  end                     
  rcode=sre_command('VAR ETAG_AUTO EXPIRES 30s NOCACHE NOIF NOWAIT   ','Backup successfully restored',idinfo,,'Content-Type: text/plain; charset=iso-8859-1') 
  return rcode
end  


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

svyerr:
call pmprintf(' error in dsurveySetup.cmd '||sigl)
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

   ilen=stream(afile,'c','query size');
   return 'ok.  '||ilen||' bytes. '||okmessage


