/* 20 Oct 2002. An SREhttp/2 addon. 

    _DIR  :   Displays files in a selected subdirectory (of the data
                  directory, and allows you to retrieve a file.

   Example:

/_DIR?/public&title=Public+Files&headerfile=READ.ME&maxlines=40&GIFS=1&subdirs=1

    Would find all files in /public (relative to the possibly host-specific
    data directory), write a <H2> header of "Public Files"
    display the READ.ME file at the top of the directory
    listing, and place small icons next tofiles.
                 
     Note that for security, only files and directories under the
     data directory (or a virtual directory) are accessible 

    For the details, see _DIR.HTM.
    For a form that makes it easy to specify different _DIR paramters,
    see _DIR.SHT.

  If just one item in argument list: it is assumed to be a directory 
  to be displayed as:
     ICON  filename.ext   14 Feb 1996  12,122
   (using <PRE> to format).

*/


/************************/
_DIR:


/******* USER CONFIGURABLE PARAMETERS ---------- */

/* If 1, then before displaying contents of a directory, check 
   ATTRIBS.CFG to see if access is allowed to the directory.
   If 2, do this for the directory and ALL and subdirectories within it
   If 0, do not check
   In all 3 cases, DIR_EXCLUSION and INCLUSION_LIST are also checked.
   Note that 2 (check all files) may be quite time consuming.
   Note that if access is required, an authorization response may occur.
*/
always_check_privs=1


/* Set this if you want to cache _DIR listings. 
     -1 = NEVER cache _DIR listings
      0 = Cache only if a CACHE=1 option is included with the request
      1 = Cache always, except when a CACHE=0 option is included   */
cache=1

/*  List of files, and directories, to NOT dispay 
 Note that /TEMP means "do not display TEMP subdirectory (of whatever
 directory you are displaying.
 A value of 1 means "use the srehttp2.cfg DIR_EXCLUSION parameter */

/*exclusion_list=' HTACCESS. GROUP.LST PASSWD.LST /PRIVATE /TEMP '*/
exclusion_list=1 


/* space delimited list of extensions to "check if they are .ZIP files"
   (do NOT include leading . )
   If used, this should always include "ZIP" (w/o the leading period).
   You might also want to include EXE (for self extracting files).  
   Or, to only use  .ZIP files (without checking file contents), 
   set zip_file_exts=0.
   Note that if filerexx.dll is not available, zip_file_exts is set to 0.
*/

zip_file_exts='ZIP EXE'

/* bgcolor, etc to use in <TR > elements of tables. Used when TR_COLORS=1 option is specified */

/*  TR_COLORS.0 -- number of entries --- _DIR will cycle through these entries. 
    TR_COLORS=0 means "no bgcolor, etc. in <TR >" 
    TR_COLORS.n -- a string with bgcolor, background, align, etc. */
tr_colors.0=2
tr_colors.1=' bgcolor="#999900" '
tr_colors.2=' bgcolor="#aacc22" '


/******* End of  USER CONFIGURABLE PARAMETERS ---------- */

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

if verb="" then do
   say " This SREhttp/2 addon is not meant to be run in stand-alone mode "
   exit
end 

signal on syntax name err1
signal on error name err1
signal on novalue name err1

call init1

do until messages=" "

  parse var messages amess '&' messages
  if amess='' then iterate
  parse var amess messname '=' messval0
  messname=strip(translate(messname)) ; 
  messval0=strip(sre_packur(translate(messval0,' ','+'||'0d0a09'x)))
  messval=strip(translate(messval0))
  select

    when  "DIR"=messname then adir=messval

    when messname="IMGDIR" then do
      imagepath=messval
      if abbrev(translate(messval),'HTTP://')=0 then
         imagepath='/'||strip(translate(messval,'/','\'),,'/')||'/'
    end

   when messname="SIZEFMT" then  sizefmt=messval

   when messname="DATEFMT" then do  
        ada=wordpos(messval,'B C D E M N O S U W')
        if ada>0 then datefmt=messval
   end 

   when messname="CACHE" then do
        if cache>-1 then cache=messval
   end 

    when messname="TITLE" then  title=messval

    when abbrev(messname,'PATT')=1 then do
        if messval<>0 then inclusion_list=inclusion_list||' '||messval
   end

    when messname="GIFS" then showgifs=messval

    when messname="SORTBY" then do
       sortby=wordpos(messval,'NAME DATE SIZE EXT DESC')
    end    

    when messname="TABLEBORDER" then tableborder=messval

    when messname="DESC_HTML" then desc_html=messval

    when messname="DMODE" then do
        if wordpos(messval,'PRE UL DL GRID TABLE')>0 then dmode=messval
    end

    when messname="CELLSPACING" then
        if datatype(messval)="NUM"  then cellspacing=messval
    
    when messname="HEADERFILE" then do
        tmp=messval
        if  tmp="" | tmp=0 then
           headerfile=0
        else
           parse var  tmp headerfile .
      end

    when messname="DESC_FILE_ONLY" then desc_file_only=wordpos(messval,'1 2')

    when messname="DESCRIP_FILE_TYPE" then do
        jj=wordpos(messval,'0 1 2')
        if jj>0  then jj=jj-1
        descrip_file_type=jj
   end

    when messname="DESCRIP_FILE" then do
        tmp=messval
        if  tmp="" | tmp=0 then
           descrip_file=0
        else
           parse var  tmp descrip_file
      end

    when messname="FOOTERFILE" then do
        tmp=messval
        if  tmp="" | tmp=0 then
           footerfile=0
        else
           parse var  tmp footerfile .
      end

   when abbrev(messname,"TR_C")=1 & tr_colors.0>0  then  do
       tr_colors=messval
   end

   when messname="TARGET_WINDOW" then do
       targ_window=strip(messval)
   end

   when messname="DIR_PAGE" then do
       dir_page=strip(messval)
   end

    WHEN MESSNAME="RECORD" THEN dorecord=messval

    when messname="AUTO_DESCRIBE" then do
        select 
         when messval="NO"  then auto_describe=0
         when messval="YES" then auto_describe=250
         when datatype(messval)<>'NUM' then auto_describe=0
         otherwise auto_describe=max(0,messval)
       end
    end

   WHEN MESSNAME="SHOWDATE" THEN do
        IF messval=1 then showdate=1
        if messval=2 then showdate=2
   end

   WHEN MESSNAME="SHOWTIME"  then showtime=messval

   WHEN MESSNAME="SHOWSIZE" THEN showsize=messval

    when messname="COLS" | messname="TABLECOLS" then do
        if datatype(messval)="NUM" then tablecols=messval
    end

    when messname="TERSE" then terse=strip(messval)

    when messname="NO_RECURSE" then no_recurse=strip(messval)

    when messname='EXPAND_ZIP' then do_zipexpand=messval

   when messname="DOEXPANDZIP" then do
         foo=pos('BACKTO=',upper(messages))
         backto=' '
         if foo<>0 then backto=substr(messages,foo+8)
         zipfile=messval

   end  /* Do */

    when messname="FILE_FROMZIP" then do
       file_fromzip=messval  /* regular processing will find the dir= optino */
    end  /* Do */
    when messname="ZIPFILE" then do
       zipfile=messval  /* regular processing will find the dir= optino */
    end  /* Do */

    when messname="ROOTDIR" then rootdir=messval

    when pos("LINE",messname)>0 then
        if datatype(messval)="NUM" then maxlines=messval

    when pos("DISPFILE_HTML",messname)>0 then hdrfile_html=messval

    when (pos("SHOWDIR",messname)+pos("SUBDIR",messname))>0 then do
        dodirs=1                /* 1=bottom */
        if messval=2  then  dodirs=2  /* 2= top */
        if messval=0 | messval='' then dodirs=0  /* 0=none */
    end
 
    when messname="FORCETEXT" then do
         forcetext=strip(messval)
    end

    otherwise
         nop
   end           /* select messname */
 
end            /* END OF OPTIONS PARSING LOOP */

adir=translate(strip(adir),'/','\')
adir=strip(adir,'t','/')

foodir=adir
if foodir=' ' then foodir='/'
foodir2='/'strip(foodir,'l','/')

if showtime=1 & showdate<>1 then showtime=0     /* no time w/o date */

if abbrev(translate(rootdir),"!")=1 then rootdir=foodir
oldmess2=oldmess
/*replace ROOTDIR="!" with ROOTDIR=rootdir (the variable's value) */
/* bascially, this only happens on the first call to _DIR (the one
   from a form).  Subsequent calls, due to traversal of the directory
   tree via clinking on links generated by _DIR, will retain this "first
   call value of ROOTDIR" */

oldmess2=sre_replacestrg(oldmess2,'=!','='||rootdir)


/* check privileges? */
always_check_privs=strip(always_check_privs)

if always_check_privs=2 & privset='' & aiter='' then do
   rcode='PRIVS Privileges may be needed to view files and subdirectories. If you do not have an account on this site, leave the username and password fields empty. '
   return rcode
end


if always_check_privs=2 then do         /* check for dynamic privileges */
   moreprivs=sreh2_dynamic_privs('READ','!USER',,,id_info)
/* add privileges */
   privset=translate(privset)
   do until moreprivs=''
       parse var moreprivs a1 ' ; ' moreprivs
       parse var a1 u0 a1 ; 
       do until a1=''
           parse var a1 a1a a1 ;a1a=strip(translate(a1a))
           if a1a=','  then iterate
           if wordpos(a1a,privset)=0 then privset=privset||' '||a1a
        end
   end 
end

if wordpos(always_check_privs,'1 2')>0 then do  /* check for access to this directory */
  csel=foodir2
  if right(csel,1)<>'/' then csel=foodir2||'/'
  istat=sreh2_auto_check_privs(csel,privset,host_nickname,id_info)
  if istat=0 then do            /* privileges not sufficient */
     rcode='AUTH Privileges are needed to list this directory: 'csel
     if aiter='' then rcode='PRIVS Privileges are needed to list directory: 'csel
     return rcode
  end
end

if descrip_file=='0' | descrip_file='' then do
    if descrip_file_type=1 then descrip_file='_DIR.LST'  /* single line */
    if descrip_file_type=2 then descrip_file='_DIR.KEY' /* keyed */
end 
if descrip_file='' then  descrip_file=0 then do

if descrip_file=0 then desc_file_only=0

if desc_file_only<>0 then do
    inclusion_list='' 
    exclusion_list=''
end 

if title="" | title=0 then  title=' List of files in ' ||foodir
tmp=adir||'/*.*'
lookin=sreh2_auto_fig_file_name(tmp,host_nickname,,id_info)

dp=strip(filespec('d',lookin)||filespec('p',lookin),'t','\')
if right(dp,1)=':' then dp=dp||'\'
isdir=dosisdir(dp)



/* later, add thumbindex thingie here? */


/*SPECIAL CASE:  check for "zip file expansion */
if zipfile<>0  & file_fromzip=0 then do
   if candozip=0  then do
        call error_4
       return 'FILE ERASE TYPE text/html NAME' tempfile
   end  /* Do */
   foo=show_zipdir(zipfile,adir,backto,lookin)  /* show_zip will creat the tempfile */
   return 'FILE ERASE TYPE text/html NAME' tempfile
end  /* Do */

/* Special case: extract a file from a zip file */
if file_fromzip<>0 then do
   if candozip=0  then do
       call error_4
       return 'FILE ERASE TYPE text/html NAME' tempfile
   end 
  foo=send_zipfile(file_fromzip,zipfile,lookin)
  return foo
end

/* Commence regular directory display --- */

if lookin = " " | lookin=0 | isdir=0 then do               /* ERROR */
      call error_0
      return 'FILE ERASE TYPE text/html NAME' tempfile
end

/* if here, directory exists so get its files amd directories */

rc = SysFileTree(lookin,'flist', 'FT')
if rc <> 0 then do    /* error */
     call error_1
     return 'FILE ERASE TYPE text/html NAME' tempfile
end

dirlist.0=0
if dodirs>0 then do
     rc2=sysfiletree(lookin,'dirlist',"OD")
     if rc2 <> 0 then do    /* error */
       call error_3
       return 'FILE ERASE TYPE text/html NAME' tempfile
     end
end

thepath=delstr(lookin,pos('\*.*',lookin))
if VERBOSE>1 then call sre_pmprintf("_DIR: Getting files from " thepath)

/* look in dir cache? */
if cache=1 then do              /* is file caching supported? */
   mx=sre_value('H2_FILECACHE_MAXFILES',,'SRE')
   if mx=0 then cache=0
end
if cache=1 then do
  hdr_tag='' ; ftr_tag=''
  if headerfile<>0 then do
    isfile=do_readmelines(headerfile,1)
    goo=sysfiletree(isfile,'fooh','FT')
    if fooh.0>0 then hdr_tag=fooh.1
  end
  if footerfile<>0 then do
    isfile=do_readmelines(footerfile,1)
    goo=sysfiletree(isfile,'fooh','FT')
    if fooh.0>0 then  ftr_tag=fooh.1
  end

/* make a hash */
  call make_hash
/* see if it's in the file_cache */
  aname=host_nickname||':_DIR?/'||strip(adir,,'/')||'#'||hash
  gotcfile=sreh2_file_cache(aname,,,id_info,'GET')
  parse var gotcfile jstat jname

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

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

end

call lineout tempfile,' <!DOCTYPE HTML PUBLIC  "-//Netscape Comm. Corp.//DTD HTML//EN">'
call lineout tempfile, "<html><head><title>Listing of "servername foodir2" </title></head>"
abgcolor=''
call lineout tempfile, "<body "||abgcolor||" >"


call get_file_descrips  /* since description file might be used for sorting */

call get_file_info      
if dodirs>0 then call get_dir_info


/* top of page links back to _DIR.SHT (or similar) page */
if dir_page<>'' then
  call lineout tempfile,'<font size=-1><a href="'||dir_page||'">List a new directory?</a> ||  </font>'
if not_allowed>0 then
  call lineout tempfile,'<font size=-1><a href="#notall">Some files not displayed ... </a> </font>'

/* default, or specified, title for top of page */
call lineout tempfile,'<h2> ' title ' </h2>'

if terse=0 then do           /* terse=1 means "terser" output */
  nff=flist_links.0
  if dodirs>0 then do
     ndd=dlist_links.0
     call lineout tempfile,terse"  <strong> " nff " files,  and " ndd " subdirectories, in " foodir2 " </strong> "
     if not_included>0 then call lineout tempfile,'<em>'not_included' files &amp; directories were not included </em>'
  end
  else do
     call lineout tempfile,"  <strong> "  nff " files in " foodir2 " </strong> "
     if not_included>0 then call lineout tempfile,'<em>'not_included' files were not included </em>'
  end

    CAll lineout tempfile," <p> Select the file you want to retrieve "
    call lineout tempfile,' <em> You might need to turn on your browser''s "Save to file mode" option </em>'
    if nzipfs>0 then do
      call lineout tempfile,' <blockquote> The  <b>+</b> icon (or the <u>[vu]</u> link) will '
      call lineout tempfile,' <em>expand</em> a .ZIP archive </blockquote>'
    end

end

if headerfile<>0  then do
    call showdafile headerfile,maxlines,hdrfile_html
end

if dodirs=2 then call show_dlist

call show_flist         /* display the files */

if dodirs=1 then call show_dlist

if footerfile<>0  then do
    call showdafile footerfile,maxlines,hdrfile_html
end

if terse=0 then do
  call lineout tempfile,' <p><em> ' servername'/' strip(adir,'l','/') '</em>'
end

if not_allowed>0 then do
  call lineout tempfile,'<a name="notall"><hr></a><table><tr><td><em>Note: </em> </td><td> due to access control restrictions,'
  call lineout tempfile,' several files &amp; sub-directories are not displayed. '

 rlink="/_DIR?DIR="||adir||oldmess2


  call lineout tempfile,'You may want to try <a href="/dynp_log?'||rlink||'">logging on as a different user</a>. </td></table>'
end 

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

rcode=sre_command('FILE TYPE text/html nocache etag_auto name 'tempfile,,id_info)

/* save as a _DIR-cache entry in the FILE_CACHE? */
if cache<>1 then return rcode

/* cache identifier is the crc of exclusion list, arguments,
    and sysfiletree info */

/* params='FILE='||tempfile||' ; TRIGGER_TYPE=HASH ; HASH='||hash||' ; STATUS=ASIS ' */

params='FILE='||tempfile||' ;  STATUS=ASIS '

foo=sreh2_file_cache(aname,params,0,,'PUT')  /* do not wait for answer */
return rcode

return 1


/************* ====== ***************/
/* initialize stuff */
init1:


poop=translate(list,' ','&=')
/* if no options give, use this as the default */
if words(poop)=1 then do   /* is a "default listings" request, for the "poop" dir */
   list='dir='||strip(poop)||'&subdir=TOP&rootdir=!&showgifs=1&showdate=1&showtime=1&showsize=1&dodirs=1&dmode=PRE&terse=1'
end  

candozip=sre_value('UNZIP_DLL',,'SRE')

tindex.0=0
imagepath='/SRE2k/SREHTTp2/IMGS/'   /* be sure to end with a / */
imagesize="width=24 height=24"
list=sre_packur(list)               /* fix up */

if exclusion_list=1 then do
    exclusion_list=sreh2_value('DIR_EXCLUSION',,host_nickname)
end  
exclusion_list=translate(translate(exclusion_list,' ','/\'))

dirgif='<img src="'ImagePath'menu.gif"' imagesize 'alt="[dir]">'
backgif='<img src="'ImagePath'back.gif"' imagesize 'alt="[..]">'
ballgif='<img src="'ImagePath'blueball.gif"' imagesize 'alt="[**]">'
expndgif='<img src="'ImagePath'expand.gif"' imagesize 'alt="[vu]">'


/* retain old message (a record of directory traverses */

oldmess=list
if left(translate(oldmess),4)="DIR=" then do
    foo1=pos('&',oldmess)
    oldmess=delstr(oldmess,1,foo1)
end
else do
  foo1=pos("&DIR=",oldmess)
  if foo1>0 then do
    foo2=pos('&',oldmess,foo1+1)
    if foo2>0 then
       oldmess=delstr(oldmess,foo1+1,foo2-foo1)
  end
end
oldmess='&'||oldmess

messages=list

not_included=0
not_allowed=0
nzipfs=0

/* Get options */

sortby=0
showgifs=0 ; maxlines=1000000 ;  
targ_window=0
dir_page=''
dmode='UL'

dodirs=0 ;  title=0; 
dorecord=0
showdate=0; showsize=0
showtime=0 ; sizefmt=0 ; 
datefmt='N'
forcetext=0 ;  rootdir=0 ;  
terse=0


no_recurse=0

auto_describe=0
desc_html=0
descrip_file=0 ; descrip_file_type=0
desc_file_only=0

adir="/"
inclusion_list=' '

zipfile=0               /* invoking a zip expansion */
do_zipexpand=0          /* make zip expansion lins */
file_fromzip=0       /* extract file from .zip file */

tr_colors=0
tablecols=''            /* # of columns in GRID mode */
tableborder=0 ;  cellspacing=2


headerfile=0 ; footerfile=0
hdrfile_html=0
noauto_header=0

return 1


/**********/
/* make a hash, given dir, file, parameter, etc info 
   return in HASH */
make_hash:
hash=space(exclusion_list)||' '||hdr_tag||' '||ftr_tag
do mm=1 to flist.0
    hash=hash||' '||flist.mm
end
do mm=1 to dirlist.0
    hash=hash||' '||dirlist.mm
end 

/* now add parameters: */ 
varshere='IMGDIR DATEFMT SIZEFMT IMGDIR TITLE INCLUSION_LIST SHOWGIFS SORTBY '|| ,
         ' TABLEBORDER DESC_HTML CELLSPACING '
varshere=varshere||'  DESCRIP_FILE_TYPE DESCRIP_FILE  DMODE TR_COLORS TR_COLORS.0 TARG_WINDOW '||, 
          '  DIR_PAGE DORECORD AUTO_DESCRIBE SHOWDATE SHOWTIME SHOWSIZE TABLECOLS '
varshere=varshere||' TERSE DMODE DO_ZIPEXPAND ROOTDIR MAXLINES HDRFILE_HTML DODIRS FORCETEXT '
varshere=varshere||'DESC_FILE_ONLY '
vadir='/'||strip(adir,,'/')
hash=hash||' '||vadir
do mm=1 to words(varshere)
     aw=strip(word(varshere,mm))
     hash=hash||' '||value(aw)
end 

hash=c2x(stringcrc(hash))

return 1

/****************/
/* display a list of files, using info in FLIST.
   Depends on dmode

    flist_links.iuse.!ZHREF=dazip

    flist_links.iuse=file_name (no path)
    flist_links.iuse.!size=asize
    flist_links.iuse.!date=adate1
    flist_links.iuse.!HREF=adir||"/"||afil
*/

show_flist:

select
   when dmode='PRE' then do             /* pre mode */
      call pre_mode
   end 
   when dmode='UL' then do
      call ul_mode
   end 
   when dmode='DL' then do
      call dl_mode
   end 
   when dmode='GRID' then do
      call grid_mode
   end 
   when dmode='TABLE' then do 
     call table_mode
   end
otherwise
end  
return 0

/****************/
/* display a list of files, using info in FLIST.
   Depends on dmode

     dlist_links.imm=parent_dir
     dlist_links.imm.!HREF="/_DIR?DIR="||parent_dir||oldmess2
    dlist_links.imm.!HREF2='... parent'

*/

show_dlist:

select
   when dmode='PRE' then do             /* pre mode */
      call dpre_mode
   end 
   when dmode='UL' then do
      call dul_mode
   end 
   when dmode='DL' then do
      if desc_file_only=0 | (desc_file_only=2 & descrips.0=0) then call dul_mode
   end
   when dmode='GRID' then do
      call dgrid_mode
   end 
   when dmode='TABLE' then do 
      if desc_file_only=0 | (desc_file_only=2 & descrips.0=0) then do
        call dtable_mode
      end
   end
otherwise
end  
return 0

/* ----------------------------------- */
/* pre mode, for directories*/
dpre_mode:
if dlist_links.0=0 then return ' '

call lineout tempfile,' '
call lineout tempfile,'<pre>'

aa='   <u>SubDirectories</u>'
if showgifs=1 then aa='   '||aa
call lineout tempfile,aa

call lineout tempfile,' '
f1='  '
if showgifs=1 then f1=dirgif

do mm=1 to dlist_links.0
  f1a=f1||'  <a href="'||dlist_links.mm.!href||'">'||dlist_links.mm.!HREF2||'</a>'
  call lineout tempfile, f1a
end 
call lineout tempfile,'</pre>'

return 0



/* ----------------------------------- */
/* ul mode, for directories*/
dul_mode:
if dlist_links.0=0 then return ' '

call lineout tempfile,' '
call lineout tempfile,'<p>&nbsp;&nbsp;<u>SubDirectories</u>'

call lineout tempfile,'<ul>'

f1=''
if showgifs=1 then f1=dirgif

do mm=1 to dlist_links.0
   dname=dlist_links.mm

   ii1=lastpos('/',dname)
   dname=substr(dname,ii1+1)
   f1a=f1||'<a href="'||dlist_links.mm.!href||'">'||dlist_links.mm.!HREF2||'</a>'
   call lineout tempfile,'<li>'||f1a

   hh=''
   adesc='01'x        /* "not defined" flag */
   if descrip_file_type>0 then do
      vv='!'||strip(translate(dname))
      adesc=descrips.vv
   end 
   if adesc<>'01'x then do  /* file based description (even if empty) was found */
      hh=adesc
   end

   if hh<>'' then do
      if desc_html<>1 then hh='<tt>'||sre_html_encode(translate(hh,' ','0d0a009'x))||'</tt>'
      call lineout tempfile,'&nbsp;&nbsp;'||hh
   end


end 
call lineout tempfile,'</ul>'
return 0




/* ----------------------------------- */
/* ul mode, for directories*/
dgrid_mode:
if dlist_links.0=0 then return ' '

call lineout tempfile,' '
call lineout tempfile,'<p>&nbsp;&nbsp;<u>SubDirectories</u>'

inrow=0

bb=''
if tableborder>0 then bb='border='||strip(tableborder)
cc=''
if cellspacing>0 then cc=' cellspacing='||strip(cellspacing)

call lineout tempfile,'<table '||bb||' '||cc||' > '

f1=''
if showgifs=1 then f1=dirgif

do mm=1 to dlist_links.0
  if inrow=0 then call lineout tempfile,'<tr>'

  f1a=f1||'<a href="'||dlist_links.mm.!href||'">'||dlist_links.mm.!HREF2||'</a>'

  inrow=inrow+1
  goof=''
  if tr_colors=1 then do
          itr=inrow//tr_colors.0
          if itr=0 then itr=tr_colors.0
          goof=tr_colors.itr
  end 
  call lineout tempfile,'<td '||goof||'>&nbsp;&nbsp;'|| f1a||'</td>'

end
call lineout tempfile,'</table>'
return 0


/* ----------------------------------- */
/* ul mode, for directories*/
dtable_mode:

if dlist_links.0=0 then return ' '

call lineout tempfile,' '
call lineout tempfile,'<p>&nbsp;&nbsp;<u>SubDirectories</u>'

inrow=0

bb=''
if tableborder>0 then bb='border='||strip(tableborder)
cc=''
if cellspacing>0 then cc=' cellspacing='||strip(cellspacing)

call lineout tempfile,'<table '||bb||' '||cc||' > '

f1=''
if showgifs=1 then f1=dirgif
nthrow=0
do mm=1 to dlist_links.0
  nthrow=nthrow+1

  call lineout tempfile,'<tr>'

  f1a=f1||'<a href="'||dlist_links.mm.!href||'">'||dlist_links.mm.!HREF2||'</a>'

  goof=''
  if tr_colors=1 then do
          itr=nthrow//tr_colors.0
          if itr=0 then itr=tr_colors.0
          goof=tr_colors.itr
  end 
  call lineout tempfile,'<tr '||goof||'><td>&nbsp;&nbsp;'|| f1a||'</td>'

end
call lineout tempfile,'</table>'
return 0



/* ----------------------------------- */
/* pre mode */
pre_mode:

atarg=''
if  targ_window=1 then atarg=' target="viewer" '

hdr='    <u>'
if nzipfs>0 then hdr=hdr||'    '
if showgifs=1 then hdr=hdr||'  '
mxfchars=3
do mm=1 to flist_links.0
   mxfchars=max(mxfchars,length(flist_links.mm))
end 
hdr=hdr||'Name'||copies(' ',mxfchars-3)

if showdate=1 | showtime=1 then do
   hdr=hdr||'Last Modified         '
end
if showsize=1 then do 
    if showtime=1 | showdate=1 then
        hdr=hdr||'Size '
    else
        hdr=hdr||'           Size  '
end 
hdr=hdr||'</u>'

call lineout tempfile,'<PRE>'
call lineout tempfile,hdr
call lineout tempfile,' '

mmlast=flist_links.0
if srts.0<>0 then mmlast=srts.0

if datatype(mmlast)<>'NUM' then mmlast=0

do mm00=1 to mmlast
   
  if srts.0=0 then
        mm=mm00
  else
        mm=srts.mm00
  fname=flist_links.mm

  f1=' '
  if showgifs=1 then                  /* descriptive icon? */
      f1=f1||imageicon(fname)||' '

   if flist_links.mm.!Zhref<>'' then do           /* zip expansion stuff? */
       f1=f1||'<a href="'||flist_links.mm.!zhref||'">'
       if showgifs=1 then
                 f1=f1||expndgif||'</a> '
             else
                 f1=f1||'[vu]</a> '
    end
    else do
              f1=f1||' &nbsp;&nbsp; '
    end 
    f1=f1||'<a '||atarg||' href="'||flist_links.mm.!href||'">'||fname||'</a>'
    jdd=3+mxfchars-length(flist_links.mm)
    f1=f1||left(' ',jdd,' ')

     if showdate=1 | showtime=1 then  f1=f1||flist_links.mm.!Date
     jdd=20-length(flist_links.mm.!date)
     f1=f1||left(' ',jdd,' ')

     if showsize=1 then f1=f1||right(flist_links.mm.!SIZE,max(7,length(flist_links.mm.!size)),' ')

     call lineout tempfile, f1
end
call lineout tempfile,'</PRE>'

return 1         



/* ----------------------------------- */
/* ul mode */
ul_mode:

atarg=''
if  targ_window=1 then atarg=' target="viewer" '

call lineout tempfile,' '
call lineout tempfile,'<p>&nbsp;&nbsp;<u>Files</u>'
call lineout tempfile,'<ul> '

mmlast=flist_links.0
if srts.0<>0 then mmlast=srts.0
if datatype(mmlast)<>'NUM' then mmlast=0

do mm00=1 to mmlast

  if srts.0=0 then
        mm=mm00
  else
        mm=srts.mm00


  fname=flist_links.mm
  f1=' '

   if flist_links.mm.!Zhref<>'' then do           /* zip expansion stuff? */
       f1=f1||'<a href="'||flist_links.mm.!zhref||'">'
       if showgifs=1 then
                 f1=f1||expndgif||'</a> '
             else
                 f1=f1||'[vu]</a> '
    end
    else do
        if showgifs=1 then                  /* descriptive icon? */
              f1=f1||imageicon(fname)||' '
        else
              f1=f1||'&nbsp;'
    end 
    f1=f1||'<a '||atarg||' href="'||flist_links.mm.!href||'">'||fname||'</a>'
     if showdate=1 | showtime=1 | showsize=1 then f1=f1||' ('
     if showdate=1 | showtime=1 then do 

         f1=f1||space(flist_links.mm.!Date)
         if showsize=1 then f1=f1||', '
     end
     if showsize=1 then f1=f1||'<tt>'||flist_links.mm.!SIZE||'</tt>'
     if showdate=1 | showtime=1 | showsize=1 then f1=f1||' )'
     call lineout tempfile,'<li>'|| f1


     hh=''
     adesc='01'x        /* "not defined" flag */
     if descrip_file_type>0 then do
           vv='!'||strip(translate(fname))
           adesc=descrips.vv
     end 
     if adesc<>'01'x then do  /* file based description (even if empty) was found */
         hh=adesc
     end
     else do
         if auto_describe>0   then do  /* auto describe */
             hh=flist_links.mm.!DESC
         end
     end

     if hh<>'' then do
        if desc_html<>1 then hh='<tt>'||sre_html_encode(translate(hh,' ','0d0a009'x))||'</tt>'
        call lineout tempfile,'&nbsp;&nbsp;'||hh
     end


end
call lineout tempfile,'</ul>'

return 1         
         

/* ----------------------------------- */
/* grid mode */
grid_mode:

atarg=''
if  targ_window=1 then atarg=' target="viewer" '
call lineout tempfile,' '
call lineout tempfile,'<p>&nbsp;&nbsp;<u>Files</u>'


inrow=0

bb=''
if tableborder>0 then bb='border='||strip(tableborder)
cc=''
if cellspacing>0 then cc=' cellspacing='||strip(cellspacing)

call lineout tempfile,'<table '||bb||' '||cc||' > '


mmlast=flist_links.0
if srts.0<>0 then mmlast=srts.0

if datatype(mmlast)<>'NUM' then mmlast=0

do mm00=1 to mmlast

  if srts.0=0 then
        mm=mm00
  else
        mm=srts.mm00

  if inrow=0 then call lineout tempfile,'<tr>'

  fname=flist_links.mm
  f1=' '

   if flist_links.mm.!Zhref<>'' then do           /* zip expansion stuff? */
       f1=f1||'<a href="'||flist_links.mm.!zhref||'">'
       if showgifs=1 then
                 f1=f1||expndgif||'</a> '
             else
                 f1=f1||'[vu]</a> '
    end
    else do
        if showgifs=1 then                  /* descriptive icon? */
              f1=f1||imageicon(fname)||' '
        else
              f1=f1||'&nbsp;'
    end 
    f1=f1||'<a '||atarg||' href="'||flist_links.mm.!href||'">'||fname||'</a>'
     if showdate=1 | showtime=1 | showsize=1 then f1=f1||' ('
     if showdate=1 | showtime=1 then do 

         f1=f1||space(flist_links.mm.!Date)
         if showsize=1 then f1=f1||', '
     end
     if showsize=1 then f1=f1||'<tt>'||flist_links.mm.!SIZE||'</tt>'
     if showdate=1 | showtime=1 | showsize=1 then f1=f1||')'
     inrow=inrow+1
     goof=''
     if tr_colors=1 then do
          itr=inrow//tr_colors.0
          if itr=0 then itr=tr_colors.0
          goof=tr_colors.itr
      end 
      call lineout tempfile,'<td '||goof||'>'|| f1||'</td>'

      if inrow=tablecols then inrow=0

end
call lineout tempfile,'</table>'

return 1         
         
/* ----------------------------------- */
/* grid mode */
table_mode:

atarg=''
if  targ_window=1 then atarg=' target="viewer" '

nthrow=0

bb=''
if tableborder>0 then bb='border='||strip(tableborder)
cc=''
if cellspacing>0 then cc=' cellspacing='||strip(cellspacing)

call lineout tempfile,'<br><table '||bb||' '||cc||' > '

/* create table columns */

aa='<tr><th>files and subdirectories</th>'
jcols=0
if showdate=1 then do
  jcols=jcols+1
  aa=aa||'<td><u>creation date</u></td>'
end
if showsize=1 then do 
  aa=aa||'<td align="right"><tt>&nbsp;size&nbsp;</tt></td>'
  jcols=jcols+1
end 
if auto_describe>0 | descrip_file_type>0 then do
  aa=aa||'<td><tt>description</tt></td>'
  jcols=jcols+1
end 
jcols=max(jcols,1)

call lineout tempfile,aa

mmlast=flist_links.0
if srts.0<>0 then mmlast=srts.0
if desc_file_only=1 then mmlast=descrips.0.!ICT0
if desc_file_only=2 & descrips.0>0 then mmlast=descrips.0.!ICT0

if datatype(mmlast)<>'NUM' then mmlast=0

do mm00=1 to mmlast

  if desc_file_only=1 | (desc_file_only=2 & descrips.0>0) then do
     fname=descrips.0.mm00
     adesc=descrips.0.mm00.!DESC
     vv='!'||strip(translate(fname))
     mm=flist_links.vv
  end 
  else do
     if srts.0=0 then
        mm=mm00
     else
        mm=srts.mm00
     fname=flist_links.mm
  end

  if fname='[DESC]' then do
     call lineout tempfile,'<tr bgcolor="#bbbbbb">'
     call lineout tempfile,'<td colspan='||jcols+1||'>'||adesc||'</td>'
     iterate
  end

  if mm='' & dodirs<>0 then do              /* no such entry  -- perhaps dir? */
     vv='!\'||strip(translate(fname))
     dmm=dlist_links.vv
     if datatype(dmm)<>'NUM' then do
        call lineout tempfile,'<tr bgcolor="#d9d9d9"><td><u>'||fname||'</u></td>'
        call lineout tempfile,'<td <td colspan='||jcols||'><tt><em>Not found: </em>'||adesc||'</tt></td>'
        iterate
     end
     f1=''
     if showgifs=1 then f1=dirgif
     if no_recurse=1 then
        f1a=f1||'<a href="'||dlist_links.dmm||'/">'||dlist_links.dmm.!HREF2||'</a>'
     else
        f1a=f1||'<a href="'||dlist_links.dmm.!href||'">'||dlist_links.dmm.!HREF2||'</a>'
     call lineout tempfile,'<tr bgcolor="#d9d9d9"><td>'||f1a||'</td>'
     call lineout tempfile,'<td <td colspan='||jcols||'><tt>'||adesc||'</tt></td>'
     iterate
  end


  nthrow=nthrow+1
  goof=''
  if tr_colors=1 then do
          itr=nthrow//tr_colors.0
          if itr=0 then itr=tr_colors.0
          goof=tr_colors.itr
  end 
  aa='<tr '||goof||'>'

  f1=''

   if flist_links.mm.!Zhref<>'' then do           /* zip expansion stuff? */
       f1=f1||'<a href="'||flist_links.mm.!zhref||'">'
       if showgifs=1 then
                 f1=f1||expndgif||'</a> '
             else
                 f1=f1||'[vu]</a> '
    end
    else do
        if showgifs=1 then                  /* descriptive icon? */
              f1=f1||imageicon(fname)||' '
        else
              f1=f1||'&nbsp;'
    end 
    f1=f1||'<a '||atarg||' href="'||flist_links.mm.!href||'">'||fname||'</a>'

     aa=aa||'<td>'||f1||'</td>'
   
     if showdate=1 then aa=aa||'<td>'||space(flist_links.mm.!Date)||'</td>'
     if showsize=1 then aa=aa||'&nbsp;&nbsp;<td  align="right"><tt>'||flist_links.mm.!SIZE||'&nbsp;&nbsp;</tt></td>'

     hh=''
     adesc='01'x        /* "not defined" flag */
     if descrip_file_type>0 then do
           vv='!'||strip(translate(fname))
           adesc=descrips.vv
     end 
     if adesc<>'01'x then do  /* file based description (even if empty) was found */
         hh=adesc
     end
     else do
         if auto_describe>0   then do  /* auto describe */
             hh=flist_links.mm.!DESC
         end
     end
     if hh<>'' then do
          if desc_html<>1 then hh='<tt>'||sre_html_encode(translate(hh,' ','0d0a009'x))||'</tt>'
          aa=aa||'<td>'||hh||'</td>'
     end

     call lineout tempfile,aa     
end
call lineout tempfile,'</table>'

return 1         


/* ----------------------------------- */
/* dl mode */
dl_mode:

atarg=''
if  targ_window=1 then atarg=' target="viewer" '

call lineout tempfile,'<dl> '

mmlast=flist_links.0
if srts.0<>0 then mmlast=srts.0
if desc_file_only=1 then mmlast=descrips.0.!ICT0
if desc_file_only=2 & descrips.0>0 then mmlast=descrips.0.!ICT0

if datatype(mmlast)<>'NUM' then mmlast=0

do mm00=1 to mmlast
  if desc_file_only=1 | (desc_file_only=2 & descrips.0>0) then do
     fname=descrips.0.mm00
     adesc=descrips.0.mm00.!DESC
     vv='!'||strip(translate(fname))
     mm=flist_links.vv
  end 
  else do
     if srts.0=0 then
        mm=mm00
     else
        mm=srts.mm00
     fname=flist_links.mm
  end

  if fname='[DESC]' then do
     call lineout tempfile,'<dt> <p>'
     call lineout tempfile,'<dd>'||adesc||'0d0a'x||'<p>'||'0d0a'x
     iterate
  end

  if mm='' then do              /* no such entry  -- perhaps dir? */
     vv='!\'||strip(translate(fname))
     dmm=dlist_links.vv
     if datatype(dmm)<>'NUM' then do
        call lineout tempfile,'<dt><u>'||fname||'</u>'
        call lineout tempfile,'<dd><tt><em>[Not found] </em> '||adesc||'</tt>'
        iterate
     end
     f1=''
     if showgifs=1 then f1=dirgif
     f1a=f1||'<a href="'||dlist_links.dmm.!href||'">'||dlist_links.dmm.!HREF2||'</a>'
     call lineout tempfile,'<dt>'|| f1a
     call lineout tempfile,'<dd><tt>'||adesc||'</tt>'
     iterate
  end

  f1=' '

   if flist_links.mm.!Zhref<>'' then do           /* zip expansion stuff? */
       f1=f1||'<a href="'||flist_links.mm.!zhref||'">'
       if showgifs=1 then
                 f1=f1||expndgif||'</a> '
             else
                 f1=f1||'[vu]</a> '
    end
    else do
        if showgifs=1 then                  /* descriptive icon? */
              f1=f1||imageicon(fname)||' '
        else
              f1=f1||'&nbsp;'
    end 
    f1=f1||'<a '||atarg||' href="'||flist_links.mm.!href||'">'||fname||'</a>'
     if showdate=1 | showtime=1 | showsize=1 then f1=f1||' ('
     if showdate=1 | showtime=1 then do 

         f1=f1||space(flist_links.mm.!Date)
         if showsize=1 then f1=f1||', '
     end
     if showsize=1 then f1=f1||'<tt>'||flist_links.mm.!SIZE||'</tt>'
     if showdate=1 | showtime=1 | showsize=1 then f1=f1||' )'
     call lineout tempfile,'<dt>'|| f1



     hh=''
     adesc='01'x        /* "not defined" flag */
     if descrip_file_type>0 then do
           vv='!'||strip(translate(fname))
           adesc=descrips.vv
     end 
     if adesc<>'01'x then do  /* file based description (even if empty) was found */
         hh=adesc
     end
     else do
         if auto_describe>0   then do  /* auto describe */
             hh=flist_links.mm.!DESC
         end
     end
     if hh<>'' then do
        if desc_html<>1 then hh='<tt>'||sre_html_encode(translate(hh,' ','0d0a009'x))||'</tt>'
        call lineout tempfile,'<dd>'||hh
     end

end
call lineout tempfile,'</dl>'

return 1         

         


/****************/
/* read description files */
get_file_descrips:


descrips.='01'x         /* flag for "not defined' */
descrips.0=0

if wordpos(descrip_file_type,'1 2')=0 then do
   descrip_file_type=0
   return 0
end

parse var lookin adir_abs '\*.*' .
dfile=adir_abs||'\'||descrip_file
dstuff=sre_read_file(dfile,3,2,1)

if dstuff='' then do
   if verbose>1 then call sre_pmprintF("_DIR: missing description file: "dfile)
   descrip_file_type=0
   return 1
end 


ict=0
ict0=0
if descrip_file_type=1 then do  /* single line */
   do forever
      if dstuff='' then leave
      parse var dstuff aline '0d0a'x dstuff
      aline=strip(aline)
      if aline='' | abbrev(aline,';')=1 then iterate
      parse var aline afile  adesc
      parse var afile afile ':' . ; afile=strip(translate(afile))
      if abbrev(strip(adesc),':')>0 then parse var adesc . ':' adesc
      if afile='' then iterate
      vv='!'||strip(translate(afile))
      if vv='![DESC]' then do
           if desc_file_only=0 then iterate /* ignore if not used */
           ict0=ict0+1
           descrips.0.ict0='[DESC]'
           descrips.0.ict0.!DESC=strip(adesc)
           iterate
      end 
      descrips.vv=strip(adesc)
      ict=ict+1
      descrips.vv.!ct=ict

      if desc_file_only>0 then do
         ict0=ict0+1
         descrips.0.ict0=afile
         descrips.0.ict0.!DESC=strip(adesc)               /* used if desc_file_only=1 */
      end
   end
   descrips.0=ict
   if desc_file_only>0 then  descrips.0.!ICT0=ict0
   return 1
end

/* otherwise, keyed file */
parse var dstuff . '{' dstuff   /* remove descriptive comments at beginning */
do forever
    if dstuff='' then leave
    parse var dstuff afile '}' adescrip '{' dstuff
    if afile='' then iterate
    vv='!'||strip(translate(afile))
    if vv='![DESC]' then do
           if desc_file_only=0  then iterate /* ignore if not used */
           ict0=ict0+1
           descrips.0.ict0='[DESC]'
           descrips.0.ict0.!DESC=strip(adescrip)
           iterate
    end 
    descrips.vv=strip(adescrip)
    ict=ict+1
    descrips.vv.!ct=ict

    if desc_file_only>0 then do
         ict0=ict0+1
         descrips.0.ict0=afile
         descrips.0.ict0.!DESC=strip(adescrip)     /* used if desc_file_only=1 */
    end

end 
descrips.0=ict
if desc_file_only>0 then   descrips.0.!ICT0=ict0

return 1


/********/
/* create links to get subdirectories ? */
get_dir_info:
dlist_links.=''

imm=0

aadir=strip(adir)
if abbreV(adir,'/')=0 then aadir='/'||aadir

/* check if at root directory. If so, do NOT add "parent" link */
if aadir<>'/' & rootdir<>0 then do     /* if /, this must be rootdir */
  tadir=translate(strip(aadir))
  trootdir=translate(strip(rootdir))
  if tadir<>trootdir then do  /* not exactly the same, ... */
     if abbrev(tadir,trootdir) then do   /* this is NOT the rootdir */
        ill1=lastpos('/',aadir)
        parent_dir=left(aadir,ill1)
        if parent_dir<>'/' then parent_dir=strip(parent_dir,,'/')
        imm=imm+1        
        dlist_links.imm=parent_dir
        dlist_links.imm.!HREF="/_DIR?DIR="||parent_dir||oldmess2
        dlist_links.imm.!HREF2='... parent'
      end 
   end
end

tthepath=translate(thepath)
do mm=1 to dirlist.0
  if dosisdir(dirlist.mm)=0 then iterate  /*tvfs bug fix */
  parse upper var dirlist.mm . (tthepath) teco
  teco1=translate(teco,'/','\'); 

  igg=lastpos('/',teco1)
  dirg1=substr(teco1,igg+1)

  tdirg1=translate(dirg1)
  if wordpos(tdirg1,exclusion_list)>0 then iterate
  if  inclusion_list<>' ' then do
       if wild_wordpos(tdirg1,inclusion_list)=0 then do /* not included? */
          not_included=not_included+1
          iterate
       end  
  end  
  imm=imm+1

  dlist_links.imm=translate(adir||teco,'/','\')
  goo=sre_packur_make(dlist_links.imm)

  dlist_links.imm.!HREF="/_DIR?DIR="||goo||oldmess2

  vadir='!'||strip(translate(teco))
  dlist_links.vadir=imm

  dlist_links.imm.!HREF2=dirg1
end
dlist_links.0=imm
return 1



/***********/
/* make a list of links to files */
get_file_info:

flist_links.=''
srts.0=0
iuse=0
do i=1 to flist.0
   parse var flist.i adatetime asize ee3 fname
   parse var adatetime yyy '/' mmm '/' ddd '/' hhh '/' minu
   if yyy<70  then
          yyy='20'||yyy
   else
          yyy='19'||yyy
   ndate=yyy||mmm||ddd
   atime=hhh':'minu

   afil=filespec("n",fname)
   if always_check_privs=2 then do  /* check for access to this file */
 
      fcsel=foodir2||'/'||afil
      istat=sreh2_auto_check_privs(fcsel,privset,host_nickname,id_info)
      if istat=0 then do            /* privileges not sufficient */
        not_allowed=not_allowed+1
        iterate
      end
    end

    dracula=pos('.',afil)  
    godzilla=upper(afil)
    if dracula=0 then godzilla=afil'.'
    if wild_wordpos(godzilla,exclusion_list)>0 then do  /* excluded? */
             iterate
    end  
    if  inclusion_list<>' ' then do
       if wild_wordpos(godzilla,inclusion_list)=0 then do /* not included? */
          not_included=not_included+1
          iterate
       end  
    end  

    iuse=iuse+1

    flist_links.iuse.!origdate=adatetime
    flist_links.iuse.!origsize=asize

    if dracula=0 then afil=afil||'.'

    asize=fixup_size(sizefmt,asize)
    adate1=ndate
    if showdate=1 then adate1=dateconv(ndate,'s',datefmt)
    if showtime=1 & showdate=1 then do
          geeks=copies(' ',14-length(adate1))
          adate1=adate1||geeks||atime
    end

/* get info for adding a "vu zip contents link */
    if do_zipexpand=1 then do     
       dazip=mk_zipexpand(afil,fname,oldmess) 

       if dazip<>' ' then do
          nzipfs=nzipfs+1
          flist_links.iuse.!ZHREF=dazip
       end
    end

    flist_links.iuse=afil
    vafil='!'||strip(translate(afil))
    flist_links.vafil=iuse
    flist_links.iuse.!size=asize
    flist_links.iuse.!date=adate1
    flist_links.iuse.!HREF=adir||"/"||afil

    flist_links.iuse.!HREF=sre_packur_make(flist_links.iuse.!HREF)

/* record using sendfile? Force as text/plain ? */
    if dorecord=1 then do 
        axx='/SENDFILE?file='||flist_links.iuse.!HREF||'&nowait=1'
        if forcetext=1 then axx=axx||'&FORCE=1'
        flist_links.iuse.!HREF=axx
    end
    else do
        if forcetext=1 then do
            axx='/!SENDAS_text_plain/'||strip(flist_links.iuse.!HREF,'l','/')
            flist_links.iuse.!HREF=axx
        end 
    end

  

/* descriptions */
   if auto_describe>0  then do
        hh=do_auto_describe(fname,candozip,auto_describe)
        flist_links.iuse.!DESC=hh
   end

end
flist_links.0=iuse

/* sort? */
if sortby=0 then return 0

if sortby=5 & descrip_file=0 then return 0

srts.=''
do kk=1 to iuse
  select
      when sortby=1 then do                /* name */
          srts.kk=left(kk,10,' ')||flist_links.kk
      end
      when sortby=2 then do
          srts.kk=left(kk,10,' ')||flist_links.kk.!origdate
      end
      when sortby=3 then do
          srts.kk=left(kk,10,' ')||flist_links.kk.!origsize
      end
      when sortby=4 then do     /* extension */
          bname=flist_links.kk    
          ifoo=lastpos('.',bname)
          if ifoo=0 then
             aext='.'
          else
             aext=substr(bname,ifoo)
          srts.kk=left(kk,10,' ')||translate(aext)
       end
       when sortby=5 then do   /* by order in description file */
          vv='!'||strip(translate(flist_links.kk))
          iat=descrips.vv.!ct
          if iat='01'x then  iat=900000+kk  /* past the end of the description file! */
          srts.kk=left(kk,10,' ')||iat
       end
      otherwise nop     /* should never happen */
   end 
end

/* now sort */
select
     when sortby=1 then do                /* name */
        foo=arraysort('SRTS.',1,iuse,11,,'A','I')
      end
      when sortby=2 then do             /* date */
        foo=arraysort('SRTS.',1,iuse,11,,'A','I')
      end
      when sortby=3 then do
        foo=arraysort('SRTS.',1,iuse,11,,'A','N')
      end
      when sortby=4 then do
        foo=arraysort('SRTS.',1,iuse,11,,'A','I')
      end
      when sortby=5 then do
        foo=arraysort('SRTS.',1,iuse,11,,'A','N')
      end

      otherwise nop     /* should never happen */
end                     
kk0=0
do kk=1 to iuse
  igoo=substr(srts.kk,11)
  if igoo>900000 & desc_file_only>0 then iterate   /* pre, ul, and grid modes */
  kk0=kk0+1
  srts.kk0=strip(left(srts.kk,10))
end
srts.0=kk0
return 1


/***********************/
/* read in an "intro" (or endtro) file*/
do_readmelines:
parse arg hdrfile,justname

readmelines.=''
readmelines.0=0
if hdrfile=0 then return ''

hdrfile=strip(hdrfile)
if abbrev(hdrfile,'/')=1 then do
       yow=sreh2_auto_fig_file_name(hdrfile,host_nickname,,id_info)
end
else do
       yow=thepath||'\'||hdrfile
end

if justname=1 then return yow

if stream(yow,'c','query exists')='' then do    /* no such file */ 
      if VERBOSE>1 then call sre_pmprintf( " _DIR error: Could not find header/footer file: " hdrfile)
      return ''
end

/* access control */
if  wordpos(always_check_privs,'1 2')>0 then do   /* ACCESS CONTROLS? */
   iu=lastpos('\',yow)
   if iu=0 then return ''               /* should NEVER happen, but just in case */
   au2=substr(yow,iu+1)
   dcsel=csel||au2
   istat=sreh2_auto_check_privs(dcsel,privset,host_nickname,id_info)
   if istat=0 then  do        /* privileges not sufficient */
         not_allowed=not_allowed+1
         return ' '
   end
end

astuff=sre_read_file(yow,3,2,1)
if astuff='' then do
    if VERBOSE>1 then call sre_pmprintf( " _DIR error: Could not find header or footer file: " hdrfile)
    return ''
end

jfoo=0
do until astuff=' '
      if length(astuff)=0 then leave  /*  hack */
      if astuff='' then say " astuff "
      parse var astuff aline '0d0a'x astuff
      jfoo=jfoo+1
      readmelines.jfoo=aline
end 
readmelines.0=jfoo

return ''





/*******/
/* IMAGEIcon: Return the name of the image file to use based on file type */
/*******/

imageIcon: procedure expose ImagePath ImageSize tindex. host_nickname
                     

  parse arg isfile
  gifsel=''
  e=extension(arg(1))
  size = ImageSize

  select
    when e='TXT' | e='CMD' | e='DOC' | e='FAQ' | e='SAS'
      then return '<img src="'ImagePath'text.gif"' size 'alt="[text]">'
    when e='HTM' | e='HTML'
      then return '<img src="'ImagePath'text.gif"' size 'alt="[html]">'
    when e='PS'
      then return '<img src="'ImagePath'text.gif"' size 'alt="[ps]  ">'
    when e='EXE' | e='ZIP' | e='ARC' | e='ARJ'
      then return '<img src="'ImagePath'binary.gif"' size 'alt="[bin] ">'
    when e="AU" | e="WAV" | e="MID"  | e="SND"
      then return '<img src="'ImagePath'sound.gif"' size 'alt="[snd] ">'
    when e="GIF" | e="JPG" | e="JPEG" | e="TIF" | e="TIFF" | e="BMP"
      then return '<img src="'ImagePath'image.gif"' size 'alt="[img] ">'
    when e="MPG" | e="MPEG" | e="AVI"
      then return '<img src="'ImagePath'movie.gif"' size 'alt="[mov] ">'
    otherwise
      return '<img src="'ImagePath'unknown.gif"' size 'alt="[file]">'
  end




extension: procedure expose  host_nickname
arg filename
/* If no period or only period is first char, then return "" */
if lastpos(".",filename)<2 then return ""
return translate(substr(filename, lastpos('.',filename)+1))


/* ************************************/
/* create a zip-expansion link */
mk_zipexpand:procedure expose showgifs expndgif adir  zip_file_exts candozip  host_nickname
parse arg afil2,fullname,oldmess

goon=isazipfile(fullname,zip_file_exts)
if goon<1 then return ' '

afil2=strip(afil2)
/* is a .zip file-- allow for expansion */
foo='/_DIR?doexpandzip='||afil2||'&backto=&dir='||adir||'&'||translate(oldmess,'+',' ')

return foo


/***********************/
IsAZipFile:procedure expose  host_nickname
/*  This checks if a file is really a .ZIP file instead of relying on
    a .ZIP extension.  Handy for finding Self-Extracting zip files that
    have .EXE extensions so that UNZIP can be used on them also.
    Requires the FILEREXX.DLL although it could be rewritten to use
    the Rexx stream functions instead.  I used FileRexx so the file
    in question could be opened in read share mode which stream can't do.
    Function syntax: Rc = IsFileAZipFile( FileNameToCheck ',' Verbose)
    FileNameToCheck should be a fully qualified file name, Verbose
    can be 0 = no display, 1 = say display, 2 = pmprintf display
    Function returns: -1 = Error opening file, 0 = file is NOT a zip
    file, 1 = file is a standard zip file, 2 = file is self-extracting.
    Originally written on 07/25/97 by Steve Ryckman (sryckman@simsware.com)
    Function can be freely distributed as long as this header remains intact.
(note: this has been modified by Daniel Hellerstein 
       check_for_zip=0, then just check for ZIP extenstion,
                    =1, then do the contents check
*/

parse arg AbsolutePath , zipexts
AbsolutePath = strip( AbsolutePath)

a1=lastpos('.',absolutepath);anext=''
if a1>0 then anext=upper(substr(absolutepath,a1+1))

/* standard mode: do NOT check */
if zipexts=' ' | zipexts=0 | a1=0 then do
  if anext='ZIP' then return 1
  return 0
end 

if wordpos(anext,upper(zipexts))=0  then return 0
/* else, check file contents to see if it's a zip file */

absolutepath=stream(absolutepath,'c','query exists')
if absolutepath='' then return -1

/* Check the position past the .EXE header first */
slotoffset = x2d('3BF5')
a1=sre_read_file(absolutepath,2,4,,2,slotoffset)                                                              
if abbrev(strip(a1),'-')=1 then return -1
parse var a1 . '0d0a'x datarecord

ZipFile = 0
if left(DataRecord,2)='PK' then ZipFile = 2

/* Now check the very first two bytes in the file */
slotoffset = 0
a1=sre_read_file(absolutepath,2,4,,2)                                                              
if abbrev(strip(a1),'-')=1 then return -1
parse var a1 . '0d0a'x datarecord


if left(DataRecord,2)='PK' then ZipFile = 1
return(zipfile)


/************/
/* display a foooter or header file */
showdafile:             /* display the file */

parse arg gfile,maxlines,ishtml

if maxlines=0 then return 0    /* 0 means suppress */

call do_readmelines gfile

if readmelines.0=0 then return 0  /* no such file */

call lineout tempfile,'<table bgcolor="lightgrey" border=1><tr><td>'
mm2=min(readmelines.0,maxlines)

/*  For now, don't display the filename as the  1st line 
if mm2=maxlines then
        call lineout tempfile,'<em> first 'mm2' lines of 'gfile'</em><p>'
else
        call lineout tempfile,'<em> 'gfile'</em><p>'
*/

call lineout tempfile,'<pre>'

do mm=1 to mm2
         vl=readmelines.mm
         if ishtml<>1 then vl=sre_html_encode(vl)
        call lineout tempfile,vl
end
call lineout tempfile, ' </pre> '
call lineout tempfile, ' </td></table><p> '

return 0


/*****************************/
/* error returns */
error_1:
call lineout tempfile,' <!DOCTYPE HTML PUBLIC  "-//Netscape Comm. Corp.//DTD HTML//EN">'
call lineout tempfile, "<html><head><title>Listing of "servername foodir2" </title></head>"
call lineout tempfile, "<body>"

     call lineout tempfile, "<h3>Could not get a file</h3"
     call lineout tempfile, " <p> (probably a memory problem) "
     call lineout tempfile, "<hr></body></html>"
     call lineout tempfile                          /* close */
     if VERBOSE>0 then call sre_pmprintf(" (_DIR) Memory problem ? ")
     foo=directory(olddir)
     return 1

error_0:
call lineout tempfile,' <!DOCTYPE HTML PUBLIC  "-//Netscape Comm. Corp.//DTD HTML//EN">'
call lineout tempfile, "<html><head><title>Listing of "servername foodir2" </title></head>"
call lineout tempfile, "<body>"

     if terse=0 then do
        call lineout tempfile, "<h3>Could not get a file </h3>"
        call lineout tempfile, " <p> The file directory does not exist: " adir
     end
     else
        call lineout tempfile,' <br> Unavailable '
     call lineout tempfile, "<hr></body></html>"
     call lineout tempfile                          /* close */
     if VERBOSE>0 then call sre_pmprintf(" _DIR " adir " does not exist")
     return 1
 
error_3:
call lineout tempfile,' <!DOCTYPE HTML PUBLIC  "-//Netscape Comm. Corp.//DTD HTML//EN">'
call lineout tempfile, "<html><head><title>Listing of "servername foodir2" </title></head>"
call lineout tempfile, "<body>"
       call lineout tempfile, "<h3>Could not get a subdirectory</h3>"
       call lineout tempfile, " <p> (probably a memory problem) "
       call lineout tempfile, "<hr></body></html>"
       call lineout tempfile                          /* close */
       if VERBOSE>0 then call sre_pmprintf( " (_DIR) Memory problem ? ")
       return

error_4:
call lineout tempfile,' <!DOCTYPE HTML PUBLIC  "-//Netscape Comm. Corp.//DTD HTML//EN">'
call lineout tempfile, "<html><head><title>Listing of "servername foodir2" </title></head>"
call lineout tempfile, "<body>"
  call lineout tempfile,' <!DOCTYPE HTML PUBLIC  "-//Netscape Comm. Corp.//DTD HTML//EN">'
  call lineout tempfile, "<html><head><title> Error in ZIP expansion </title></head>"
  call lineout tempfile, "<body>"
  call lineout tempfile, "<h3>UNZIP Not available</h3>"
  call lineout tempfile, " <p> server is improperly configured "
  call lineout tempfile, "<hr></body></html>"
  call lineout tempfile                          /* close */
  if VERBOSE>0 then call sre_pmprintf(" (_DIR) no unzipapi ")
  return



/* fix up size, given format */
fixup_size:procedure
parse arg sizefmt,asize
 if translate(sizefmt)="ABBREV" then do
               if asize>=1000000 then
                       return format(asize/1000000,,0)||'M'
               if asize>=1000 then 
                      return format(asize/1000,,0)||'K'
 end
/* convert to xxx,yyy,zzz */
 il=length(asize)
 if il>3 then do
           oop=""
           do mm=il to 3 by -3
               tt=substr(asize,mm-2,3)
               if mm=il then
                  oop=tt
               else
                 oop=tt||','||oop
           end /* do */
           if mm<>0 then oop=substr(asize,1,mm)||','||oop
           asize=oop
 end
 return asize    /* not abbrev, or < 1000 */



/****************/
do_auto_describe:procedure expose host_nickname
parse arg athing,ado,nbytes
ALINE0=do_auto_describe_2(ATHING,ADO,nbytes)
RETURN ALINE0



/*********************************/
/* expand a .zip file (adapted from the BBS add-on */

show_zipdir:procedure expose  tempfile ballgif backgif imagepath  ,
                imagesize forcetext showgifs candozip  host_nickname targ_window
parse arg  zipfile,adir,backto,lookin

foo=lastpos('\',lookin)
lookin=delstr(lookin,foo+1)
mkit=lookin||zipfile
rc=uzfiletree(mkit,'getem',,,'Z')
call lineout tempfile, '<!doctype html public "-//IETF//DTD HTML 2.0//EN">'
call lineout tempfile, "<HTML>"
call lineout tempfile, "<HEAD>"
call lineout tempfile, "<TITLE>Contents of "zipfile"</TITLE>"
oo=strip(adir,'t','/')'/'zipfile
call lineout tempfile, "</HEAD> <body> <h2> Contents of " oo '</h2>'


call lineout tempfile, '<pre>' ballgif '<b>'left("Name",19)||left("Last Modified",17)||right("Size",8)'</b></pre>'
call lineout tempfile, '<hr>'
fbackto=translate(backto,'+',' ')
call lineout tempfile, '<dt><pre><a href="/_DIR?'fbackto'">'||backgif||'Back</a></pre>'
call lineout tempfile, '<HR>'

atarg=''
if  targ_window=1 then atarg=' target="viewer" '

do mm=1 to getem.0
    aline=getem.mm
    Fname=word(aline,8)
    Ftime=word(aline,6)
    Fdate=word(aline,5)
    parse var  fdate mmm '-' ddd '-' yyy
    if yyy<70 then
        yyy='20'||yyy
    else
        yyy='19'||yyy
    qdate=yyy||mmm||ddd
    fdate=dateconv(qdate,'S','N')

    Fsize=word(aline,1)
    feeb=' '
    if showgifs=1 then    feeb=imageicon(fname)
    
    if forcetext=1 then
       feeb1='/_DIR?FILE_FROMZIP='fname'&DIR='adir'&forcetext=1&zipfile='zipfile
    else
       feeb1='/_DIR?FILE_FROMZIP='fname'&DIR='adir'&zipfile='zipfile
    if forcetext=1 then feeb1=feeb1||'&forcetext=1'
    if showgifs=1 then feeb1=feeb1||'&showgifs=1'
    
    feeb3=feeb||'<A '||atarg||' href="'||feeb1||'"> '||fname||'</a>'
    call lineout tempfile, '<dt><pre>'feeb3''copies(' ',max(0,20-length(Fname)))''right(Fdate,10)''right(Ftime,6)' 'right(Fsize,10)'</pre></dt>'
end

call lineout tempfile, "</dl>"
call lineout tempfile, "</BODY>"
call lineout tempfile, "</HTML>"
call lineout tempfile

aa=stream(tempfile,'c','close')

return 0




/**************/
/* Extract and send a zip file.
zipfile: The "local" file to be unzipped
zipdir:  url-directory of the zipfile
*/
send_zipfile:procedure expose tempfile forcetext showgifs candozip  host_nickname
parse arg  getfile,zipfile,lookin

foo=lastpos('\',lookin)
lookin=delstr(lookin,foo+1)
mkit=lookin||zipfile
/* make sure it exists */
if stream(mkit,'c','query exists')=' ' then  do
  call lineout tempfile, "<body><h2>Sorry...</h2>"
  call lineout tempfile,' Could not find .ZIP file: ' zipfile
  call lineout tempfile, "</body></html>"
  call lineout tempfile  /* close */
  return 'FILE ERASE TYPE text/html NAME ' tempfile
end
rc=uzunziptostem(mkit,'sook.',getfile)
if sook.0=1 then do
  arf=strip(sook.1)
  thesize=length(sook.arf)
  if thesize=0 then do  /* hack to get around unzip.dll ?bug? */
     sook.arf=uzunziptovar(mkit,getfile)
  end
  if forcetext<>0 then
     mtype='text/plain'
  else
      mtype=sreh2_get_mimetype(getfile,host_nickname)
  return 'VAR type '||mtype||' nocache '||'0d0a'x||sook.arf
end
else do
  call lineout tempfile, "<body><h2>Sorry...</h2>"
  call lineout tempfile,' Could not find Zipped file: ' getfile
  call lineout tempfile, "</body></html>"
  call lineout tempfile  /* close */
  return 'FILE ERASE TYPE text/html NAME ' tempfile
end


/***************************/
/* wild card comparison against a list */
wild_wordpos:procedure
parse arg needle,haystack
needle=strip(needle)
foo=wordpos(needle,haystack)
if foo>0 then return 1

if pos('*',haystack)=0 then return 0 /* no wildcards, so give up */

do mm=1 to words(haystack)
  aw=strip(word(haystack,mm))
  if pos('*',aw)=0 then iterate  /* no wildcard, so skip it */
  foo=sre_wild_match(needle,aw)
  if foo=0 then iterate         /* 0 means no match */
  return 1                      /* any non-0 means "match */
end
return 0



/***************/
/*Search a sorted, fixed record file for a match 
*/

search_fixed:procedure expose  host_nickname

parse arg target,thefile,numrec,reclen,recoffset,idat,idlen

oo=sre_read_file(thefile,3,2,1)
if oo<0 then return ''    /* could not open, could not read */

  ib=1
  ie=numrec
  iat=((recoffset+ib-1)*reclen)+idat
  indxib=charin(thefile,iat,idlen)

  indxib=strip(translate(indxib))

  iat=((recoffset+ie-1)*reclen)+idat
  indxie=charin(thefile,iat,idlen)
  indxie=strip(translate(indxie))
  
  target=strip(translate(target))
  
  if target << indxib then do
      foo=stream(thefile,'c','close')
      return ''
   end
  if target>>indxie then do
      foo=stream(thefile,'c','close')
      return ''
  end

/* do the binary search */
 do forever
   len=ie-ib+1
   if (len<=2) then do
     if indxie==target then  do
         iee=((recoffset+ie-1)*reclen)+1
         fgoo=charin(thefile,iee,reclen)
         foo=stream(thefile,'c','close')
         return fgoo
     end
     if indxib==target then do
         iee=((recoffset+ib-1)*reclen)+1
         fgoo=charin(thefile,iee,reclen)
         foo=stream(thefile,'c','close')
         return fgoo
     end
     foo=stream(thefile,'c','close')
     return ''  /* did not match */
   end

   imid=trunc(ib+(len/2))
   iat=((recoffset+imid-1)*reclen)+idat
   indximid=charin(thefile,iat,idlen)
   indximid=strip(translate(indximid))
   if indximid==target then do
         iee=((recoffset+imid-1)*reclen)+1
         fgoo=charin(thefile,iee,reclen)
         foo=stream(thefile,'c','close')
         return fgoo
   end

   if (indximid<<target) then do
       indxib=indximid
       ib=imid
   end
   else do
       ie=imid
       indxie=indximid
   end
 end            /* forever */


/*********/
/* Construct a description of a file.

  Note that a maximum of about 1000 characters (or 15 lines)
  is returned in a string:

 header_string=do_auto_describe(filename.ext,candozip)


Note: if a badly formatted html file is investigated (no
<HEAD>, or no <TITLE>, then it will be treated as a plain
text file.

----------- */
/* do_AUTO_DESCRIBE_2:procedure 
 construct a description from html, text, or .zip files */

do_auto_describe_2:procedure expose host_nickname
parse arg thefile,candozip,nbytes

crlf='0d0a'x
thefile=strip(thefile)

/* is it a .zip file? */
if right(upper(thefile),4)='.ZIP' & candozip=1   then do

   zipcmts.0=0     /* try using a file_id.diz file */
   rc=uzfiletree(thefile,'getem')
   do km=1 to getem.0
      if upper(getem.km)='FILE_ID.DIZ' then do
         rc=uzunziptovar(thefile,getem.km,zipcmts)
         if rc<>0 then zipcmts.0=0
         leave
      end
   end
   if zipcmts.0>0 then do   /* use first 15 lines of file_id.diz */
      oof=zipcmts.1
      do te=2 to min(15,zipcmts.0)
         oof=oof||' '||zipcmts.te
      end /* do */
      return oof
   end

  zipcmts.0=0              /* no .diz, then get -z comments */
   rc=uzunzip(' -z '||thefile,'zipcmts.')
   if rc<>0 then zipcmts.0=0
   if zipcmts.0>1 then do   /* use -z comments if available, skip generic line */
      oof=zipcmts.2
      do te=3 to zipcmts.0
         oof=oof||' '||zipcmts.te
      end /* do */
      return oof
   end

   return ' '           /* no -z, and no file_id.diz */
end  /* .ZIP file */

atype=translate(sreh2_get_mimetype(thefile,host_Nickname))

if atype='TEXT/PLAIN' then do  /*grab first auto_describe characters */
    foo=sre_read_file(thefile,3,2,,nbytes)
    return foo
end  

if atype='TEXT/HTML' then do  /* parse html, look for title or description */
   oof=get_html_descript(thefile,nbytes)
   if oof="" then do  /* must be badly formatted, treat as text file */
       oof=sre_read_file(thefile,3,2,,nbytes)
   end
   return oof
end

return ' '   /* other type, give up */


/**************************************/
/* Extract description from text/html file */
get_html_descript:procedure
parse arg filename

crlf='0d0a'x
stuff=sre_read_file(filename,3,2,,2000)   /* just get first 2000 characters */
stuff=space(translate(stuff,' ','00090a0d1a1b'x))

wow=look_header()
astring=""

if url_title<>' ' then
   astring=strip(strip(url_title),'t','.')||'.  '
if url_content<>' ' then
   astring=astring||url_content

return astring




/* ----------------------------------------------------------------------- */
/* Look for "desc" field in header     */
/* ----------------------------------------------------------------------- */

look_header: procedure expose stuff url_title url_content

url_title=""
url_content=""
dowrite=0

do until stuff=""

    parse var stuff  p1 '<' tag '>' stuff
    if  translate(strip(word(tag,1)))="HEAD" then do   /* now in head !*/
            dowrite=1
            iterate
    end
    if dowrite=0 then iterate    /* wait till we get into head .. */

    if  translate(strip(word(tag,1)))="/HEAD" then  /* out of head, all done ! */
        leave

/* IT IS A TITLE TAG?  */
     if translate(strip(word(tag,1)))="TITLE" then do
        parse var stuff url_title '<' footag '>' stuff
        if url_content<>' ' then return 0
     end

/* is it a  META HTTP-EQUIV or a META NAME ? */
    if translate(strip(word(tag,1)))="META" then do
        parse var tag ameta atype '=' rest
        tatype=translate(atype)
        if tatype="HTTP-EQUIV" | tatype="NAME" then do
           parse var rest aval1 rest
           REST=STRIP(REST)

           aval1=strip(aval1) ;
           aval1=strip(aval1,,'"')
           if abbrev(translate(aval1),'DESC')<>1 then iterate

           aval2=" "
           foo1=ABBREV(translate(rest),'CONTENT')
           if foo1>0 then do
                PARSE VAR REST FOO '=' AVAL2
                aval2=strip(aval2)
                aval2=strip(aval2,'b','"')
                url_content=LEFT(AVAL2,1000)
                if url_title<>' ' then return 0
                iterate
           end
        end             /* name or http-equiv */
    end         /* meta */
end             /* stuff */


return 0




