/**  Gawd v1.0
 **
 **  Gallant Amiga Web Daemon
 **
 **  ©1996 Giorgos 'Gallant' Stagakis
 **/

/** Web Directory **/

path = "amitcp:www"  /** Warning: This must not end on a / (slash) and it
                      **          must be a directory, not an assign/device!
                      **/

   /** Note: The client will not be able in any way, to access another
    **       path than the one you set above!
    **       For security, 'protect #? -wed' inside that path.
    **/

/** Main Program **/

signal on halt
signal on syntax

if ~show('L','rexxtricks.library') then if ~addlib('rexxtricks.library',0,-30,0) then exit

client = readln(stdin)

if word(client,1) = 'GET' then do

  doc = word(client,2)

  if right(doc,1) = '/' then doc = left(doc,length(doc)-1)
  doc_file = filepart(doc)
  doc_args = ''
  if pos('?',doc_file) > 0 then parse var doc_file doc_file'?'doc_args
  if exists(pathpart(path||doc'/'doc_file)) then if ~getdir(pathpart(path||doc),doc_file,'','F') then doc = doc'/index.html'

  doc_file = filepart(doc)

  doc_args = ''
  if pos('?',doc_file) > 0 then parse var doc_file doc_file'?'doc_args

  doc_suffix = suffixpart(doc_file)
  doc_path = pathpart(path||doc)
  doc_locate = left(doc,length(doc)-length(doc_file))

  if doc_suffix = 'cgi' then cgi = 1
  else cgi = 0

  filetype = mimetype(doc_suffix)
  senttype = 0
  say "HTTP/1.0 200 OK"
  say "Server: Gawd/1.0a"
  say "Date: "left(date(w),3)", "word(date(),1)"-"word(date(),2)"-"right(word(date(),3),2)" "time()
  if (pos('//',doc) > 0)|(pos(':',doc) > 0)|(pos('#?',doc) > 0)|(pos('*',doc) > 0) then call herror('404')
  if ~cgi then if exists(path||doc) then address command 'List 'path||doc' LFORMAT "Last-modified: %d %t*NAccept-ranges: bytes*NContent-length: %l"'
  if cgi & ~exists(doc_path'/'doc_file) then call herror('404')

  if ~cgi & ~exists(path||doc) then do
    if upper(doc_file) ~= 'INDEX.HTML' then call herror('404')
    if upper(doc_file) = 'INDEX.HTML' then call hyperls(doc_path,doc_locate,doc)
  end

  if cgi then do
    if pos('?',doc) > 0 then parse var doc doc'?'doc_args
    address command
    path||doc' 'doc_args' >T:cgi.out'
    if exists('T:cgi.out') then do
      'copy T:cgi.out STDIO:'
      'run >nil: delete T:cgi.out'
    end
    exit
  end

  if filetype ~= '???' then call sendtype(filetype)
  address command 'copy 'path||doc' STDIO:'

end

exit

/** Main Procedures **/

copyright: procedure
return "<hr><em><b>Gawd v1.0 &copy;1996 Giorgos 'Gallant' Stagakis<b></em>"

mimetype: procedure
  parse arg suf
  suf = upper(suf)
  select
    when (suf = 'HTML')|(suf = 'HTM') then filetype = 'text/html'
    when (suf = 'TXT')|(suf = 'README')|(suf = 'DOC')|(suf = 'C')|(suf = 'CC')|(suf = 'H')|(suf = 'REXX')|(suf = 'RX') then filetype = 'text/plain'
    when (suf = 'GIF') then filetype = 'image/gif'
    when (suf = 'JPG')|(suf = 'JPEG')|(suf = 'JFIF')|(suf = 'JPE') then filetype = 'image/jpeg'
    when (suf = 'TIFF')|(suf = 'TIF') then filetype = 'image/tiff'
    when (suf = 'HAM') then filetype = 'image/x-ham'
    when (suf = 'IFF') then filetype = 'image/x-ilbm'
    when (suf = 'XWD') then filetype = 'image/x-xwindowdump'
    when (suf = 'MOD') then filetype = 'music/x-mod'
    when (suf = 'GUIDE') then filetype = 'text/x-aguide'
    when (suf = 'MPEG')|(suf = 'MPG')|(suf = 'MPE') then filetype = 'video/mpeg'
    when (suf = 'QT')|(suf = 'MOV') then filetype = 'video/quicktime'
    when (suf = 'ANIM') then filetype = 'video/x-anim'
    when (suf = 'CDXL')|(suf = 'XL') then filetype = 'video/x-cdxl'
    when (suf = 'AVI') then filetype = 'video/x-msvideo'
    when (suf = 'MOVIE') then filetype = 'video/x-sgi-movie'
    when (suf = 'LHA')|(suf = 'LZH')|(suf = 'LZX')|(suf = 'ZIP')|(suf = 'GZ')|(suf = 'GZIP') then filetype = 'application/octet-stream'
    when (suf = 'AI')|(suf = 'EPS')|(suf = 'PS') then filetype = 'application/postscript'
    when (suf = 'AU')|(suf = 'SND') then filetype = 'audio/basic'
    when (suf = '8SVX') then filetype = 'audio/x-8svx'
    when (suf = 'AIF')|(suf = 'AIFF')|(suf = 'AIFC') then filetype = 'audio/x-aiff'
    when (suf = 'WAV') then filetype = 'audio/x-wav'
    otherwise
      filetype = '???'
  end
return filetype

hyperls: procedure expose senttype
  parse arg doc_path,doc_locate,doc
  if pos('?',doc_path) > 0 then call herror('404')
  address command "ls -l "doc_path"/ >T:hyperls.temp"
  if open(1,'T:hyperls.temp') then do
    s1 = readln(1)
    if (pos(': object not found',s1) > 0)|(pos(': device (or volume) is not mounted',s1) > 0) then do
      address command 'run >nil: delete T:hyperls.temp'
      call herror('404')
    end
    call sendtype('text/html')
    say '<html>'
    say '<head><title>Dir of 'doc_locate'</title></head>'
    say '<body><br><h2>Directory of 'doc_locate':</h2><hr>'
    say '<pre>'
    say s1
    do while ~eof(1)
      s = readln(1)
      if s ~= '' then do
        rests = left(s,45)
        files = right(s,length(s)-45)
        if word(rests,1) ~= 'total' then say rests'<a href="'doc_locate||files'">'files'</a>'
        else say s
      end
      s = ''
    end
    say '<br></pre>'
    say copyright()
    say '</body></html>'
  end
  else do
    address command "run >nil: delete T:hyperls.temp"
    call herror('500')
    exit
  end
  call close(1)
  address command "run >nil: delete T:hyperls.temp"
exit

sendtype: procedure expose senttype
  parse arg a
  if senttype = 0 then do
    say 'Content-type: 'a
    say ''
    senttype = 1
  end
return 1

replace: procedure
  parse arg a,b,c
  d = index(a,b)
  do while d ~= 0
    a = insert(c,delstr(a,d,length(b)),d-1)
    d = index(a,b)
  end
return a

/** Error Procedures **/

syntax:
  call herror(rc)
exit
herror:
  call sendtype('text/html')
  parse arg herr
  say '<html><head><title>'herrorshort(herr)'</title></head>'
  say '<body><h1>'herrorshort(herr)'</h1>'
  say herrortext(herr)
  say copyright()
  say '</body></html>'
exit
herrortext:
  parse arg herr
  select
    when herr = '404' then htext = 'The requested URL 'doc' was not found on this server.'
    when herr = '500' then htext = 'Internal server error.'
    otherwise
      htext = '( Error description not yet implement )'
  end
return htext
herrorshort:
  parse arg herr
  select
    when herr = '404' then htext = '404 Not Found.'
    otherwise
      htext = '500 Server Error.'
  end
return htext
halt:
exit