/* hs.rexx
**
** Name:        hs.rexx
** Description: HTTP server - connection handler macro
** Version:     33.0
** Date:        27.11.2001
** Author:      Alfonso Ranieri <alforan@tin.it>
** Status:      GPL
**/

signal on halt
signal on break_c
signal on break_d
signal on syntax
signal on error

call init
call start
exit
/* never reached */
/***************************************************************************/
halt:
break_c:
break_d:
    exit
/***************************************************************************/
syntax:
    call sen "[hs syntax at line" sigl ErrorText(rc)"]"
    exit
/***************************************************************************/
error:
    call sen "[hs error at line" sigl ErrorText(rc)"]"
    exit
/***************************************************************************/
init: procedure expose hserv.

    hserv.sock=LastSocket()
    if hserv.sock=-1 then exit

    call VarToStem("hserv.#?")
    if ~hserv.inetd then call MacroNotifyJoin(hserv.MacroNotify)

    call pragma("W","N")
    hserv.RootDir=ProgDir()
    call pragma('priority',hserv.Pri)
    hserv.DocumentDir=RName(hserv.DocumentDir)
    hserv.CGIDir=RName(hserv.CGIDir)
    if hserv.Admin~="" then hserv.mailAdmin = '<A HREF="mailto:'hserv.Admin'">WebMaster</A>'

    call SetHostName()
    call SysLogCtl("hserv["hserv.port"]")
    call pragma("D",hserv.RootDir)

    hserv.defMime="text/plain"
    hserv.inetDate="%m %w %d %Y %H:%M:%S GMT"

    call SetSockOpt(hserv.sock,"socket","SNDTIMEO",hserv.Timeout,0)
    call SetSockOpt(hserv.sock,"socket","RCVTIMEO",hserv.Timeout,0)
    call IOCtlSocket(hserv.sock,"FIONBIO",0) /* XXX bhaaaaa! */
    call SetSocketBaseSingle("BREAKMASK",or(2**12,2**13))

    hserv.ErrorImage       = 0
    hserv.GatewayInterface = "CGI/1.0"
    hserv.ServerProtocol   = "HTTP/1.1"
    hserv.ServerSoftware   = hserv.name"/"hserv.ver

    return
/***************************************************************************/
start: procedure expose hserv.

    /* get peer info */
    if ~GetPeerInfo() then call ErrorAnswer(403,'Sorry,<br>you are not welcome here.')

    hserv.KeepAliveFlag=1
    do nc=0 to hserv.KeepAlive while hserv.KeepAliveFlag

        /* read request */
        res=ReadRequest()
        if res~=0 then
            if res=-1 then call ErrorAnswer(400,'Host <em>'hserv.this.host'</em> is not available.')
            else call ErrorAnswer(res)

        /* check status */
        if hserv.status=1 then call ErrorAnswer(503,'Sorry &lt;'hserv.peerHTML'&gt;,<br>This service is temporarily unavailable.')

        /* check Ident service */
        if ~CheckIdent() then call ErrorAnswer(420,'Sorry &lt;'hserv.peerHTML'&gt;,<br>you must have the ident service running to access this site.')

        /* log request */
        if hserv.TransferLog~=1 then
            if nc=0 then call TransferLog("HTTP/"hserv.maior"."hserv.minor "connection from" hserv.userat "Method:" hserv.this.method "Request:" hserv.this.file)
            else call TransferLog("Request#"nc "from" hserv.userat "Method:" hserv.this.method "Request:" hserv.this.file)

        /* admin pure racism test */
        if hserv.OnlyAmigaClient then
            if pos("AMIGA",upper(hserv.this.client))=0 then call ErrorAnswer(403,'Sorry &lt;'hserv.useratHTML'&gt;,<br>only Amiga clients are welcome here.')

        /* check k-lines */
        res=CheckIP()
        if res~="" then call ErrorAnswer(403,'Sorry &lt;'hserv.useratHTML'&gt;,<br>you are not welcome here: <b>'res'</b>')

        /* we can send def.image at this point */
        hserv.ErrorImage=hserv.DefImage

        /* parse file */
        res=ParseFileName()
        select
            when res=-1 then exit
            when res=0 then nop
            when res=404 then call ErrorAnswer(404,'File "'hserv.this.file'" not found.<br>Mail the ' hserv.MailAdmin  'if you think that''s not correct.')
            otherwise call ErrorAnswer(res)
        end

        /* check Masks */
        if ~CheckMask() then call ErrorAnswer(403,'Sorry &lt;'hserv.useratHTML'&gt;,<br>you don''t have access to "'hserv.this.file'".')

        /* check Auth */
        res=CheckAuth()
        if res~="" then call ErrorAnswer(401,'Sorry &lt;'hserv.useratHTML'&gt;,<br>you don''t have access to <b>'res'</b>.',res)

        /* test Referer */
        if ~TestReferer() then call ErrorAnswer(413,'Sorry &lt;'hserv.useratHTML'&gt;,<br>you want to go to <em>'hserv.this.file'</em> from a wrong place.')

        /* methods */
        select
            when hserv.this.method="GET" then do
                if hserv.since~="" then if ~CheckSince(hserv.since,hserv.this.complete) then call ErrorAnswer(304)
                if hserv.this.handler="SEND" then call SendFile(hserv.this.complete,0,0,200)
                else call DoCGI
            end
            when hserv.this.method="POST" then call DoCGI
            when hserv.this.method="HEAD" then call SendFile(hserv.this.complete,1,0,200)
            otherwise call ErrorAnswer(400)
        end
    end
    return
/***************************************************************************/
DoCGI: procedure expose hserv.
    f=ExCGI(hserv.this.complete,hserv.this.query,hserv.this.handler)
    if f~="" then call SendFile(f,0,1,200)
    else call ErrorAnswer(501,'Sorry, the requested CGI can''t be executed')
    return
/***************************************************************************/
sen: procedure expose hserv.
parse arg buf,s
    if arg(2,'o') then s=hserv.sock
    rs=send(s,buf)
    if rs<=0 then do
        if rs<0 then do
            ern=errno()
            if find("4 32 35 54",ern)=0 then call ErrLog("error sending %m" hserv.peerHTML)
            exit
        end
    end
    return
/***************************************************************************/
ReadRequest: procedure expose hserv.
    buf=""
    p=0
    do while p=0
        res=recv(hserv.sock,"B",512)
        if res=0 then return ErrLog("link closed" hserv.peerHTML,500)
        if res<0 then do
            ern=errno()
            if ern=4 | ern=35 then exit
            if ern~=54 then call ErrLog("error reading %m" hserv.peerHTML)
            return 500
        end
        buf=buf||b
        p=pos("0d0a0d0a"x,buf)
    end

    if p=1 then call ErrLog("empty request" hserv.peerHTML,"QUIT")

    parse var buf head "0d0a"x buf
    if words(head)<2 then return 400
    if words(head)<3 then do
        parse var head hserv.this.method" "hserv.this.file
        hserv.maior=1
        hserv.minor=0
    end
    else parse var head hserv.this.method" "hserv.this.file" HTTP/"hserv.maior"."hserv.minor

    if hserv.maior<1 then return 505
    hserv.KeepAliveFlag=hserv.KeepAliveFlag & (hserv.maior>0 & hserv.minor>0)

    hserv.this.AuthType      = ""
    hserv.this.User          = ""
    hserv.this.Accept        = "*/*"
    hserv.this.Authorization = ""
    hserv.this.Client        = ""
    hserv.this.Connection    = ""
    hserv.this.ContentLength = ""
    hserv.this.ContentType   = ""
    hserv.this.Host          = ""
    hserv.this.Range         = ""
    hserv.this.Referer       = ""
    hserv.this.RKeepAlive    = ""
    hserv.this.Since         = ""

    do k=0 while line~=""
        parse var buf line "0D0A"x buf
        if line="" then iterate
        parse var line f": "rest
        f=upper(f)
        select
            when f="ACCEPT" then hserv.this.accept=rest
            when f="AUTHORIZATION" then parse var rest "Basic "hserv.this.Authorization .
            when f="CONNECTION" then hserv.this.connection=upper(rest)
            when f="CONTENT-LENGTH" then hserv.this.ContentLength=rest
            when f="CONTENT-TYPE" then hserv.this.ContentType=rest
            when f="HOST" then hserv.this.Host=rest
            when f="IF-MODIFIED-SINCE" then hserv.this.since=rest
            when f="KEEPALIVE" then hserv.this.RKeepAlive=rest
            when f="RANGE" then hserv.this.range=rest
            when f="REFERER" then hserv.this.Referer=rest
            when f="USER-AGENT" then hserv.this.client=rest
            otherwise nop
        end
    end

    if hserv.this.host~="" then do
        parse var hserv.this.host hserv.this.host":"p .
        if p~="" then if p~=hserv.port then return -1
        if IsDotAddr(hserv.this.host) then res=(hserv.Addr~=hserv.this.host)
        else res=(hserv.HostName~=hserv.this.host)
        if res then if ~GetVirtualHost() then return -1
    end

    if hserv.this.connection~="" then
        if hserv.this.connection~="KEEP-ALIVE" then hserv.KeepAliveFlag=0

    if hserv.this.Authorization~="" then hserv.this.AuthType="Basic"

    if hserv.this.method="POST" then do
        if hserv.this.ContentLength~="" then pl=hserv.this.ContentLength
        else return 411
        if pl>65535 then return 400
        alen=length(buf)
        toread=pl-alen
        if toread<0 & toread~=-2 then return 400
        if toread>0 then do
            len=recv(hserv.sock,"BUF",toread)
            if len<0 then do
                ern=errno()
                if ern=4 then exit
                if ern~=54 then call ErrLog("error reading %m" hserv.peerHTML)
                return 500
            end
            if len>toread then return 406
            len=toread+alen
        end
        else len=pl
        if pl~=len & pl~=(len-2) then return 400
        parse var buf p"D"x
        f=CreateTempFile()
        if f="" then res=0
        else
            if ~open("in",f,"w") then res=0
            else do
                call writech("in",p)
                call close("in")
                hserv.this.post=f
                res=1
            end
        if ~res then call ErrLog("can't create temp file" hserv.peerHTML DosString(),"QUIT")
    end
    else hserv.this.post=""
    return 0
/***************************************************************************/
GetPeerInfo: procedure expose hserv.
    if GetPeerName(hserv.sock,"remote")<0 then return ErrLog("can't get peer info %m",0)
    hserv.Peer=remote.AddrAddr
    hserv.PeerPort=remote.addrPort
    hserv.PeerHTML=hserv.Peer
    hserv.PeerHost=""
    if hserv.HostNameLookups then
        if GetHostByAddr("he",remote.AddrAddr) then do
            hserv.PeerHost=he.HostName
            hserv.PeerHTML=hserv.PeerHost
        end
        else return 0
    return 1
/***************************************************************************/
AuthFun: procedure expose hserv.
parse arg ha, lp, sp

    sock=socket("INET","STREAM")
    if sock<0 then return "-ERR" errno()

    sin.addrAddr=ha
    sin.addrPort=113
    if connect(sock,"SIN")<0 then do
        call CloseSocket(sock)
        return "-ERR" errno()
    end

    request=sp","lp"D0A"x
    call sen request,sock
    ans=""
    len=recv(sock,"BUF",512)
    do while len>0
        ans=ans || buf
        len=recv(sock,"BUF",512)
    end
    call CloseSocket(sock)
    if len<0 then do
        ern=errno()
        if ern=4 then exit
        return "-ERR" ern
    end

    if index(ans,"ERROR")~=0 then do
        parse var ans "ERROR:" rest
        return "+OK unknown"
    end
    parse var ans ans"D0A"x
    return "+OK "ans
/***************************************************************************/
CheckIdent: procedure expose hserv.
    if hserv.ident then do
        auth=AuthFun(hserv.Peer,hserv.port,hserv.PeerPort)
        if left(auth,4)="-ERR" then return ErrLog("can't get ident info for" hserv.peer,0)
        else parse var auth"+OK" rp "," lp ": USERID : " sis " : " hserv.user
        hserv.useratHTML=hserv.user"@"hserv.peer
        hserv.userat="<"hserv.useratHTML":"hserv.peerPort">"
    end
    else do
        hserv.user=""
        hserv.useratHTML=hserv.peer
        hserv.userat="<"hserv.useratHTML":"hserv.peerPort">"
    end
    return 1
/***************************************************************************/
MakeHead: procedure expose hserv.
    if hserv.ErrorImage then return '<img src="/images/def.gif" ALT="hserv">'
    else return '<h1><strong>hserv 'hserv.ver'</strong></h1>'
/***************************************************************************/
ErrorAnswer: procedure expose hserv.
parse arg code,h,realm
    if hserv.Errors~="" then do
        lines=ParseConfig(hserv.Errors,"ERRORS","NOUPPER")
        if lines==-1 then call ErrLog("Errors file '"hserv.Errors"' not found","QUIT")
        do i=0 to lines-1
            if errors.i=code then leave
            if errors.i="ANY" then leave
        end
        if i<lines then do
            parse var errors.i.value macro newcode .
            if newcode="" then newcode=code
            f=ExCGI(macro,newcode hserv.this.file,GetHandler(macro))
            call SendFile(f,0,1,newcode,realm)
            exit
        end
    end
    else do
        msg=CreateHead(code,"text/html",,realm)
        if ~arg(2,'o') then do
            msg=msg'<head><title>hserv error</title></head><body bgcolor="#FFFFFF">'
            msg=msg||MakeHead()
            msg=msg'<hr><br>' h '</body>'
            if hserv.Signature~="" then do
                res=TextParse(ReadFile(hserv.Signature))
                msg=msg||"<hr>"||res
            end
        end
        call sen msg
    end
    exit
/***************************************************************************/
SendFile: procedure expose hserv.
parse arg file,head,cgi,code,realm

    if ~open("in",file,"R") then do
        call ErrLog("unable to open" file hserv.peer)
        call ErrorAnswer(404)
    end

    if cgi then do
        mime=""
        do while line~=""
            line=readln("in")
            if left(line,2)="2008"x then parse var line "2008"x line /* Rebol! */
            if left(upper(line),13)="CONTENT-TYPE:" then mime=line
        end
        if mime="" then call call ErrorAnswer(500,'Misconfigured CGI <b>' hserv.this.complete'</b>.')
        length=""
        last=""
    end
    else do
        mime=GetMime(file)
        last=GMTInetFileDate(file)
        length=hserv.this.size
    end

    if hserv.this.accept~="" then do
        mm=hserv.this.accept
        res=0
        do while mm~="" & ~res
            parse var mm m "," mm
            parse var m m ";" t
            kk=m
            parse var m a "/" b
            if a="*" then a="#?"
            if b="*" then b="#?"
            m=a || "/" || b
            res=match(m,mime)
        end
        if ~res then call ErrorAnswer(406)
    end

    resume=0
    cycle=1e9
    rest=0
    delta=hserv.SendDelta
    pt=pos("text",mime)>0

    if pt then hserv.this.parse="I"
    else hserv.this.parse="N"

    if cgi | pt then length=""
    else do
        from=0
        to=length-1
        if hserv.this.range~="" then do
            parse upper var hserv.this.range "BYTES="a "-" b "," rest
            if rest="" then do
                if a~="" then f=a
                else f=from
                if b~="" then t=b
                else t=to
                if Datatype(f,"N") & Datatype(t,"N") f>=0 & f<=t & t<length then do
                    from=f
                    to=t
                    resume=1
                    length=to-from+1
                    cycle=length%delta
                    rest=length//delta
                    code=206
                end
            end
        end
    end

    hserv.KeepAliveFlag=hserv.KeepAliveFlag & (length~="")
    ss=CreateHead(code,mime,length,realm,last,cgi)

    call sen ss

    if head then do
        call close("in")
        return
    end

    if resume then call seek("in",from,"begin")

    do for cycle while SendFun("in",delta,pt); end
    if rest>0 then call SendFun("in",rest,pt)

    call close("in")
    return

SendFun: procedure expose hserv.
parse arg fd,delta,pt
    if hserv.this.parse="I" then do
        hserv.this.parse="N"
        buf=readln("in")
        if upper(left(buf,9))="<!SERVOPT" then do
            parse upper var buf "<!SERVOPT" mode . ">"
            if mode="PARSE" then hserv.this.parse="Y"
            return 1
        end
    end
    else buf=readch("in",delta)
    if buf="" then return 0
    if pt then if hserv.this.parse="Y" then buf=TextParse(buf)
    call sen buf
    return 1
/***************************************************************************/
TextParse: procedure expose hserv.
parse arg a
    stop=0
    do while ~stop
        select

            when index(a,"<!include ")~=0 then do
                parse var a a "<!include " file ">" b
                a=a || include(file) || b
            end

            when index(a,"<!--#INCLUDE FILE=")~=0 then do
                parse var a a "<!--#INCLUDE FILE=" file "-->" b
                a=a || include(file) || b
            end

            when index(a,"<!ip>")~=0 then do
                parse var a a "<!ip>" b
                a=a || hserv.peer || b
            end

            when index(a,"<!HostName>")~=0 then do
                parse var a a "<!HostName>" b
                a=a || hserv.HostName || b
            end

            when index(a,"<!HostPort>")~=0 then do
                parse var a a "<!HostPort>" b
                a=a || hserv.Port || b
            end

            when index(a,"<!userat>")~=0 then do
                parse var a a "<!userat>" b
                a=a || hserv.useratHTML || b
            end

            when index(a,"<!user>")~=0 then do
                parse var a a "<!user>" b
                a=a || hserv.user || b
            end

            when index(a,"<!power>")~=0 then do
                parse var a a "<!power>" b
                a=a || "<em>Powered Up with <B>RxSocket!</B></em>" || b
            end

            when index(a,"<!this>")~=0 then do
                parse var a a "<!this>" b
                a=a || hserv.this.complete || b
            end

            when index(a,"<!InetDate>")~=0 then do
                parse var a a "<!InetDate>" b
                a=a || GMTInetCurrentDate() || b
            end

            when index(a,"<!ver>")~=0 then do
                parse var a a "<!ver>" b
                a=a || "hserv/"hserv.ver || b
            end

            when index(a,"<!hhp>")~=0 then do
                parse var a a "<!hhp>" b
                a=a || '<a href="http://web.tiscalinet.it/amiga/english/soft/"><!ver></a>' || b
            end

            when index(a,"<!admin>")~=0 then do
                parse var a a "<!admin>" b
                a=a || '<A HREF="mailto:'hserv.admin'">Webmaster</A>' || b
            end

            when index(a,"<!REXX ")~=0 then do
                parse var a a "<!REXX " fun ">" b
                p=PathPart(fun)
                if p~="" then old=pragma("D",p)
                else old=pragma("D",hserv.CGIDir)
                INTERPRET "res="fun
                old=pragma("D",old)
                a=a || res || b
            end

            otherwise stop=1
        end
    end

    stop=0
    do while ~stop

        select
            when index(a,"<!CGI ")~=0 then do
                parse var a a "<!CGI " fun arg">" b
                macro=AddPart(hserv.CGIDir,fun)
                f=ExCGI(macro,arg,GetHandler(macro))
                if f~="" then
                    if open("cgi",f,"READ") then do
                        l=readln("cgi")
                        call readln("cgi")
                        do while ~eof("cgi")
                            a=a||readln("cgi")
                        end
                        call Close("cgi")
                    end
                a=a||b
            end

            otherwise stop=1
        end
    end

    return a
/***************************************************************************/
InitCGI: procedure expose hserv.
parse arg macro
    if hserv.DisableCGI then return ""

    call SetVar("AUTH_TYPE",hserv.this.AuthType,"local")
    call SetVar("CLIENT_SOFTWARE",hserv.this.client,"local")
    call SetVar("CONTENT_LENGTH",hserv.this.ContentLength,"local")
    call SetVar("CONTENT_TYPE",hserv.this.ContentType,"local")
    call SetVar("DOCUMENT_ROOT",RName(hserv.DocumentDir),"local")
    call SetVar("GATEWAY_INTERFACE","CGI/1.0","local")
    call SetVar("HTTP_ACCEPT",hserv.this.accept,"local")
    call SetVar("HTTP_REFERER",hserv.this.Referer,"local")
    call SetVar("HTTP_USER_AGENT",hserv.this.client,"local")
    call SetVar("PATH_INFO",hserv.this.PathInfo,"local")
    call SetVar("PATH_TRANSLATED",hserv.this.PathTranslated,"local")
    call SetVar("QUERY_STRING",hserv.this.uri.query,"local")
    call SetVar("REMOTE_ADDR",hserv.peer,"local")
    call SetVar("REMOTE_HOST",hserv.peerHost,"local")
    call SetVar("REMOTE_IDENT",hserv.user,"local")
    call SetVar("REMOTE_USER",hserv.this.user,"local")
    call SetVar("REQUEST_METHOD",hserv.this.method,"local")
    call SetVar("SCRIPT_NAME",macro,"local")
    call SetVar("SERVER_NAME",hserv.HostName,"local")
    call SetVar("SERVER_PORT",hserv.port,"local")
    call SetVar("SERVER_PROTOCOL","HTTP/1.1","local")
    call SetVar("SERVER_SOFTWARE",hserv.name"/"hserv.ver,"local")

    if hserv.this.post="" then input="NIL:"
    else input=hserv.this.post

    return input
/***************************************************************************/
ExCGI: procedure expose hserv.
parse arg macro,args,handler

    o=pragma("D",PathPart(macro))
    m=FilePart(macro)
    macro=RName(macro)

    input=InitCGI(m)
    if input="" then return ""

    output=CreateTempFile()
    if output="" then return ErrLog("can't create temp file" hserv.peer DosString(),"")

    cmd=""
    signal off error
    select
        when handler="REXX" then do
            cmd="rxs NR <"input ">"output '"'m'"' args
            shell command cmd
        end

        when handler="CGI" & hserv.PerlPath~="" then do
            cmd=hserv.PerlPath "<"input ">"output '"'m'"' args
            shell command cmd
        end

        when handler="REBOL" & hserv.RebolPath~="" then do
            cmd=hserv.RebolPath "<"input ">"output "-cqw" '"'m'"' args
            shell command cmd
        end

        when handler="EXE" then do
            cmd='"'m'"' "<"input ">"output args
            shell command cmd
        end

        otherwise if handler~="SEND" then do
            CGIMod=GetCGIMod(handler)
            if CGIMod~="" then do
                p=PathPart(CGIMod)
                f=FilePart(CGIMod)
                call pragma("D",o)
                o=pragma("D",p)
                call setvar("MOD_MACRO",macro,"local")
                call setvar("MOD_ARGS",args,"local")
                call rxscall(f,,"sync noreport err",,,input,output)
                cmd=1
            end
        end

    end
    signal on error

    if cmd="" then output=""

    call pragma("D",o)
    return output
/***************************************************************************/
GetHeadString: procedure expose hserv.
parse arg code
    if hserv.HeadDone~=1 then do
        hserv.head.100="Continue"
        hserv.head.101="Switching Protocols"
        hserv.head.200="OK"
        hserv.head.201="Created"
        hserv.head.202="Accepted"
        hserv.head.203="Non-Authoritative Information"
        hserv.head.204="No Content"
        hserv.head.205="Reset Content"
        hserv.head.206="Partial Content"
        hserv.head.300="Multiple Choices"
        hserv.head.301="Moved Permanently"
        hserv.head.302="Moved Temporarily"
        hserv.head.303="See Other"
        hserv.head.304="Not Modified"
        hserv.head.305="Use Proxy"
        hserv.head.400="Bad Request"
        hserv.head.401="Unauthorized"
        hserv.head.402="Payment Required"
        hserv.head.403="Forbidden"
        hserv.head.404="Not Found"
        hserv.head.405="Method Not Allowed"
        hserv.head.406="Not Acceptable"
        hserv.head.407="Proxy Authentication Required"
        hserv.head.408="Request Time-out"
        hserv.head.409="Conflict"
        hserv.head.410="Gone"
        hserv.head.411="Length Required"
        hserv.head.412="Precondition Failed"
        hserv.head.413="Request Entity Too Large"
        hserv.head.414="Request-URI Too Large"
        hserv.head.415="Unsupported Media Type"
        hserv.head.420="No ident service running"
        hserv.head.500="Internal Server Error"
        hserv.head.501="Not Implemented"
        hserv.head.502="Bad Gateway"
        hserv.head.503="Service Unavailable"
        hserv.head.504="Gateway Time-out"
        hserv.head.505="HTTP Version not supported"

        hserv.HeadMax=505
        hserv.HeadDone=1
    end
    if code>hserv.HeadMax then s="Code:"code
    else s=hserv.head.code
    return "HTTP/1.1" code s
/***************************************************************************/
CreateHead: procedure expose hserv.
parse arg code,mime,length,realm,last,cgi
    msg=GetHeadString(code) || "D0A"x || "Server: hserv/" || hserv.ver || "D0A"x || "Date:" GMTInetCurrentDate() || "D0A"x
    if realm~="" then msg=msg || "WWW-Authenticate: Basic realm=" || '"' || realm || '"' || "D0A"x
    if length~="" then msg=msg || "Content-Length:" length || "D0A"x
    if last~="" then msg=msg || "Last-modified:" last || "D0A"x
    if cgi=1 then msg=msg || mime || "D0A"x
    else msg=msg || "Content-Type:" mime || "D0A"x
    if hserv.KeepAliveFlag=1 then msg=msg || "Connection: Keep-Alive" || "D0A"x
    else msg=msg || "Connection: closed" || "D0A"x
    msg=msg || "D0A"x
    return msg
/***************************************************************************/
ParseFileName: procedure expose hserv.

    if hserv.this.file="" then return 400
    if ~ParseURI(hserv.this.file,"hserv.this.uri") then return 400

    if hserv.this.uri.HostName~="" then do
        hserv.this.host=hserv.this.uri.HostName":"hserv.this.uri.Port
        hserv.this.file=hserv.this.uri.path
    end

    parse var hserv.this.uri.path "/" q
    if (index(q,"//")~=0) | (index(q,":")~=0) then return 404

    p=pos("..",q)
    do while p>0
        parse var q a ".." b
        q=a||"/"||b
        p=pos(q,"..")
    end

    hserv.this.query=hserv.this.uri.query
    hserv.this.DocumentIndex=hserv.DocumentIndex
    hserv.this.Auth=""
    hserv.this.Access=0
    hserv.this.PathInfo=""
    hserv.this.PathTranslated=""

    if upper(left(q,7))="CGI-BIN" then do
        parse var q +8 macro "/" a
        q=AddPart(hserv.CGIDir,macro)
        hserv.this.pathInfo=a
        if a~="" then hserv.this.pathTranslated=AddPart(hserv.DocumentDir,a)
        call ReadDirConf(q)
    end
    else do
        q=AddPart(hserv.DocumentDir,q)
        isdir=ReadDirConf(q)
        if FilePart(q)="" then q=AddPart(q,hserv.this.DocumentIndex)
    end

    hserv.this.complete=q

    if CheckSpecials() then return -1

    s=statef(hserv.this.complete)
    if word(s,1)~="FILE" then return 404

    hserv.this.size=word(s,2)
    hserv.this.handler=GetHandler(hserv.this.complete)

    return 0
/***************************************************************************/
GetHandler: procedure expose hserv.
parse arg name
    parse value(reverse(name)) with ext '.'
    ext=reverse(ext)
    if ext=name then ext=""
    else ext=upper(ext)
    select
        when ext="CGI" | ext="PL" | ext="SH" then res="CGI"
        when ext="REXX" then res="REXX"
        when ext="R" then res="REBOL"
        when ext="" then res="EXE"
        otherwise res="SEND"
    end

    if hserv.Handlers="" then return res

    lines=ParseConfig(hserv.Handlers,"HANDLERS","SIMPLECOMMENT")
    if lines==-1 then return ErrLog("Handlers file '"hserv.Handlers"' not found",res)
    do i=0 to lines-1
        if match(handlers.i,name) then return handlers.i.value
    end
    return res
/***************************************************************************/
SetHostName: procedure expose hserv.
    call GetSockName(hserv.sock,"hserv")
    hserv.Addr=hserv.AddrAddr
    hserv.Port=hserv.AddrPort

    if hserv.HostName="" then
        if GetHostByAddr("he",hserv.AddrAddr) then hserv.HostName=he.HostName
        else hserv.HostName=hserv.AddrAddr
    hserv.HostInfo=hserv.HostName":"hserv.Port

    return
/***************************************************************************/
ErrLog: procedure expose hserv.
parse arg msg,res
    select
        when hserv.ErrorLog=0 then call WriteFile(hserv.ErrorFile,"hs["hserv.port"]" date() time() msg,"append line")
        when hserv.ErrorLog=2 then call SysLog(msg,"ERR")
        otherwise nop
    end
    if res="QUIT" then exit
    return res
/***************************************************************************/
TransferLog: procedure expose hserv.
parse arg msg
    msg=URLDecode(msg)
    select
        when hserv.TransferLog=0 then call WriteFile(hserv.TransferFile,"hs["hserv.port"]" date() time() msg,"append line")
        when hserv.TransferLog=2 then call SysLog(msg,"INFO")
        otherwise nop
    end
    return 1
/***************************************************************************/
CheckIP: procedure expose hserv.
    if hserv.RejectedIP="" then return ""

    lines=ParseConfig(hserv.RejectedIP,"IPS","SIMPLECOMMENT")
    if lines=-1 then return ErrLog("RejectedIP file '"hserv.RejectedIP"' not found","")
    do i=0 to lines-1
        if ips.i="IP" then do
            parse var ips.i.value ips.i" "ips.i.values
            s=hserv.Peer
        end
        else do
            s=hserv.peer
            if ~hserv.HostNameLookups then iterate
        end
        if match(ips.i,s) then return ips.i.values
    end
    return ""
/***************************************************************************/
CheckAuth: procedure expose hserv.
    if hserv.this.Auth~="" then do
        if hserv.this.Authorization="" then return hserv.this.realm
        call EncodeB64(hserv.this.Auth,"enc","string var")
        if enc=hserv.this.Authorization then return ""
        return hserv.this.realm
    end
    if hserv.Auth="" then return ""
    lines=ParseConfig(hserv.Auth,"AL","SIMPLECOMMENT")
    if lines=-1 then return ErrLog("Auth file '"hserv.Auth"' not found","Secret World")

    fRealm=""
    do i=0 to lines-1
        if ~match(al.i,hserv.this.complete) then iterate
        parse var al.i.value realm "-" login pass .
        call EncodeB64(login":"pass,"enc","string var")
        if hserv.this.Authorization="" then return realm
        if fRealm="" then fRealm=realm
        if EncodeB64(login":"pass,"enc","string var") then
            if enc=hserv.this.Authorization then do
                hserv.this.user=login
                return ""
            end
    end
    return fRealm
/***************************************************************************/
TestReferer: procedure expose hserv.
    if hserv.Referers="" then return 1
    lines=ParseConfig(hserv.Referers,"AL","SIMPLECOMMENT")
    if lines=-1 then return ErrLog("Auth file '"hserv.Referers"' not found",1)

    do i=0 to lines-1
        if ~match(al.i,hserv.this.complete) then iterate
        if ~match(al.i.value,hserv.this.referer) then return 0
    end
    return 1
/***************************************************************************/
GetMime: procedure expose hserv.
parse arg file
    if hserv.MimeFile=="" then return hserv.defMime
    parse value(reverse(file)) with ext '.'
    ext=reverse(ext)
    if ext=file | ext="" then return hserv.defMime

    lines=ParseConfig(hserv.MimeFile,"MIMES","NOUPPER")
    if lines==-1 then return ErrLog("MimeFile '"hserv.MimeFile"' not found",hserv.defMime)

    ext=upper(ext)
    do i=0 to lines-1
        if find(upper(mimes.i.value),ext)~=0 then return mimes.i
    end
    return hserv.defMime
/***************************************************************************/
GMTInetCurrentDate: procedure expose hserv.
    call GetDate("D","GMT")
    return EnglishDate(formatdate("D",hserv.inetDate))
/***************************************************************************/
GMTInetFileDate: procedure expose hserv.
parse arg file
    call GetDate("NOW","GMT")
    date="NOW"
    if GetFileDate(file,"FD") then do
        call date2gmt("FD")
        if CompareDates("NOW","FD")<0 then date="FD"
    end
    return EnglishDate(formatdate(date,hserv.inetDate))
/***************************************************************************/
EnglishDate: procedure expose hserv.
    d.0="Sun";d.1="Mon";d.2="Tue";d.3="Wed";d.4="Thu";d.5="Fri";d.6="Sat"
    m.1="Jan";m.2="Feb";m.3="Mar";m.4="Apr";m.5="May";m.6="Jun";m.7="Jul";m.8="Aug";m.9="Sep";m.10="Oct";m.11="Nov";m.12="Dec"
    parse arg i j dd rest
    i=i%1
    return d.j"," dd m.i || rest
/***************************************************************************/
checkSince: procedure expose hserv.
parse arg since,file
    marray="JANUARY  FEBRUARY MARCH    APRIL    MAY      JUNE     JULY     AUGUST   SEPTEMBEROCTOBER  NOVEMBER DECEMBER"
    darray="SUNDAY   MONDAY   TUESDAY  WEDNESDAYTHURSDAY FRIDAY   SATURDAY"
    fmt="%d %m %Y %H:%M:%S"
    since=upper(since)

    date.0='dayname"," month day year hour":"minute":"second'
    date.1='dayname"," day month year hour":"minute":"second'
    date.2='dayname"," day "-" month "-" year hour":"minute":"second'
    date.3='dayname month day hour":"minute":"second year'

    found=0
    do i=0 to 3 while ~found
        line="parse var since" date.i "."
        INTERPRET line

        if length(dayname)<2 then iterate
        if pos(dayname,darray)=0 then iterate

        if length(month)<2 then iterate
        p=pos(month,marray)
        if p=0 then iterate
        month=right(p%9+1,2)

        if year<1900 then year=year+1900
        if month~=0 then do
            date = day month year hour":"minute":"second
            found=ParseDate(date,fmt,"SD")
        end
    end
    if ~found then return 1

    call GetDate("NOW","GMT")
    call GetFileDate(file,"FD")
    call date2gmt("FD")

    if CompareDates("NOW","FD")>0 then return 1
    if CompareDates("NOW","SD")>0 then return 1

    fd.tick=fd.tick-fd.tick//100
    sd.tick=sd.tick-sd.tick//100

    return CompareDates("FD","SD")<0
/***************************************************************************/
CheckSpecials: procedure expose hserv.
    if hserv.Specials="" then return 0

    lines=ParseConfig(hserv.Specials,"SP","SIMPLECOMMENT")
    if lines=-1 then return ErrLog("Special file '"hserv.Specials"' not found",0)

    do i=0 to lines-1
        if match(sp.i,hserv.this.complete) then leave
    end
    if i=lines then return 0

    if ~CheckMask() then call ErrorAnswer(403,'Sorry &lt;'hserv.useratHTML'&gt;,<br>you don''t have access to "'hserv.this.file'".')

    parse var sp.i.value type " " a " " b

    select
        when type="CODE" then do
            msg=GetHeadString(a) || "D0A"x || "Server: hserv/" || hserv.ver || "D0A"x || "Date:" GMTInetCurrentDate() || "D0A"x
            msg=msg || b || "D0A"x || "D0A"x
            call sen msg
        end
        when type="CALL" then do
            if a="" then a=hserv.this.complete
            m=FilePart(a)
            p=pathPart(a)
            input=InitCGI(m)
            o=pragma("D",p)
            call RXSCall(m b,hserv.sock,'sync',,,input)
            call pragma("D",o)
        end
        otherwise return 0
    end
    return 1
/***************************************************************************/
GetVirtualHost: procedure expose hserv.
    if hserv.VirtualHosts="" then return 1
    lines=ParseConfig(hserv.VirtualHosts,"VH","SIMPLECOMMENT NOUPPER")
    if lines=-1 then return ErrLog("VirtualHosts file '"hserv.VirtualHosts"' not found",0)

    do i=0 to lines-1
        if match(vh.i,hserv.this.Host) then leave
    end
    if i=lines then return 0

    parse var vh.i.value dd din .

    hserv.HostName=vh.i
    if dd~="" then hserv.DocumentDir=dd
    if din~="" then hserv.DocumentIndex=din

    return 1
/***************************************************************************/
include: procedure expose hserv.
parse arg f
    if f="" then return "[!!! no file given]"
    parse var f '"' t '"'
    if t~="" then f=t
    p=PathPart(f)
    if p="" then o=pragma("D",hserv.DocumentDir)
    else o=pragma("D",p)

    if open("include",f,"R") then do
        res=""
        do while ~eof("include")
            res=res || readln("include")
        end
        call close("include")
    end
    else res="[!!! can't find file '"f"']"
    call pragma("D",o)
    return res
/***************************************************************************/
ReadDirConf: procedure expose hserv.
parse arg dir
    s=statef(dir)
    if s="" then return 0
    if word(s,1)~="DIR" then do
        dir=PathPart(dir)
        isdir=0
    end
    else isdir=1
    lines=ParseConfig(AddPart(dir,"dir.conf"),"conf","SIMPLECOMMENT")
    if lines<0 then return isdir
    do i=0 to lines-1
        select
            when conf.i="DOCUMENTINDEX" then do
                hserv.this.DocumentIndex=conf.i.value
            end
            when conf.i="AUTH" then do
                parse var conf.i.value r "-" login pass .
                hserv.this.Auth=login":"pass
                hserv.this.realm=r
            end
            when conf.i="ACCESS" then do
                j=hserv.this.Access
                hserv.this.Access.j=conf.i.value
                hserv.this.Access=j+1
            end
            otherwise nop
        end
    end
    return isdir
/***************************************************************************/
CheckMask: procedure expose hserv.
    if hserv.this.Access>0 then do
        do i=0 to hserv.this.Access-1
            if match(hserv.this.Access.i,hserv.Peer) then return 1
        end
        return 0
    end
    return 1
/***************************************************************************/
GetCGIMod: procedure expose hserv.
parse arg handler
    hserv.CGIMod="PROGDIR:conf/cgi-mod"
    if hserv.CGIMod="" then return ""
    lines=ParseConfig(hserv.CGIMod,"CGIMOD","SIMPLECOMMENT")
    if lines=-1 then return ErrLog("CGIMod file '"hserv.CGIMod"' not found","")

    do i=0 to lines-1
        if match(CGIMod.i,handler) then return CGIMod.i.value
    end
    return ""
/***************************************************************************/
RName: procedure
parse arg f
    o=pragma("D",PathPart(f))
    return AddPart(pragma("D",o),FilePart(f))
/***************************************************************************/
/*
$VER: hs.rexx 33.0 (27.11.2001)*/