Content-type: text/html
#!/usr/bin/newlisp ; ; httpd - web server v.4.1 ; v 4.1 - change 'integer' to 'int' ; handles cgi but no cookies ; ; does GET and POST requests ; ; USAGE: httpd portNo rootDir ; ; EXAMPLE Linux: httpd 80 /home/httpd/html/ ; ; EXAMPLE Win32: newlisp.exe httpd 80 /home/httpd/html/ ; (context 'HTTPD) (define version "4.1") (define debug-flag nil) (set 'os (& 0xF (last (sys-info)))) (set 'exe-extensions '( "cgi" "lsp")) (set 'default-files '("index.html" "index.cgi")) (set 'mime-types '( ("txt" "text/plain") ("html" "text/html") ("shtml" "text/html") ("htm" "text/html") ("gif" "image/gif") ("jpg" "image/jpeg") ("jpeg" "image/jpeg") ("png" "image/png") ("jar" "application/java-archive") ("class" "application/java") ("pdf" "application/pdf"))) (set 'cgi-header (append "HTTP/1.0 200 OK\r\n" "Server: newLISP v." (string (nth -2 (sys-info))) " HTTPD v." version "\r\n")) (define (startServer port dir) (if (not (set 'socket (net-listen (int port)))) (print "Listen failed: " (net-error) "\n") (begin (set 'online true) (set 'root-dir dir) (print "Server started listening on port: " port "\n") (print "Root directory: " root-dir "\n") (if (not (change-dir root-dir)) (begin (println "Could not change to: " root-dir) (exit))) (net-server-accept socket)))) (define (net-server-accept listenSocket) (while online (if (set 'connection (net-accept listenSocket)) (begin (if (net-receive connection 'buff 2024 "\r\n\r\n") (begin (process-http-request buff) (net-close connection))))))) (define (process-http-request request) (set 'request-type (first (parse request))) (if debug-flag (print request)) (log-request request) (case request-type ("GET" (process-GET-request request)) ("POST" (process-POST-request request)) ("HEAD" (process-HEAD-request request)) (true (html-error 400 "Cannot handle request")))) (define (process-GET-request request) (set 'query (nth 1 (parse (first (parse request "\r\n")) " "))) (if (starts-with query "http://" nil) (begin (set 'query (slice query 7)) (set 'query (slice query (find "/" query))))) (set 'query (slice query 1)) (if (= query "") (begin (set 'query (first default-files)) (dolist (fle default-files) (if (file? fle) (set 'query fle))))) (if (set 'pos (find "?" query)) (begin (set 'queryData (slice query (+ pos 1))) (env "QUERY_STRING" queryData) (set 'query (first (parse query "?"))) (execute-file query (append queryData "\r\n"))) (begin (env "QUERY_STRING" "") (if (find {.*\.\..*} query 0) (html-error 405 "Access not allowed") (if (has-exe-extension query) (execute-file query "") (send-file query)))))) (define (process-POST-request request) (if (find ".*content-length:(.*)" request 1) (begin (set 'contentLength (int (trim $1))) (set 'postData (receive-POST-data contentLength))) (set 'postData (net-receive connection 'data 1024))) (if debug-flag (print postData "\n")) (set 'query (nth 1 (parse (first (parse request "\r\n"))))) (if (find {.*\.\..*} query 0) (html-error 405 "Access not allowed") (execute-file query postData))) (define (receive-POST-data len) (set 'page '("")) (set 'receivedBytes 0) (set 'bytes 0) (while (and bytes (< receivedBytes len)) (if (set 'bytes (net-receive connection 'data len)) (inc 'receivedBytes bytes)) (push data page)) ; drain socket (while (net-select connection "read" 500) (net-receive connection 'data 1024)) (join (reverse page))) (define (process-HEAD-request request) (html-error 400 "Cannot handle request")) (define (has-exe-extension fileName) (find (extension fileName) exe-extensions)) (define (extension fname) (if (find ".*\\.(.*)" fname 0) (trim $1) "")) (define (send-file fileName) (set 'ext (extension fileName)) (if (not (set 'mime-type (assoc ext mime-types))) (html-error 405 "Filetype not allowed") (begin (set 'buffer (read-file fileName)) (if (not buffer) (html-error 404 (append "File not found: " fileName) ) (begin (set 'header (make-header mime-type fileName)) (net-send connection header) (net-send connection buffer)))))) (define (make-header mimeType fileName) (append "HTTP/1.0 200 OK\r\n" "Server: newLISP HTTPD v." version "\r\n" "Content-type: " (nth 1 mimeType) "\r\n" "Content-length: " (string (first (file-info fileName))) "\r\n\r\n")) (define (execute-file fileName data) (if (starts-with fileName "/") (set 'fileName (slice fileName 1))) (if (not (file? (append "./" fileName))) (html-error 404 (append "File not found: ./" fileName) ) (begin (if (or (= os 5) (= os 6)) (set 'procStr (append "newlisp ./" fileName " > /tmp/pcgi" )) ;; for win32 (set 'procStr (append "./" fileName " > /tmp/pcgi" ))) ;; for UNIX (if debug-flag (println procStr)) (exec procStr data) (set 'buffer (read-file "/tmp/pcgi")) (replace "\r\r\n" buffer "\r\n") (set 'header "HTTP/1.0 200 OK\r\n") (if (not buffer) (html-error 400 "Cannot handle request") (begin (net-send connection cgi-header) (net-send connection buffer)))))) (define (log-request request) (print (date (apply date-value (now))) " " (first (net-peer connection)) " " (first (parse request "\r\n")) "\n" )) (define (html-error error-no error-txt) (set 'header "HTTP/1.0 200 OK\r\nContent-type: text/html\r\n\r\n") (set 'message (append "<HTML><H1>newLISP v." (string (nth -2 (sys-info))) " HTTPD v." version "<BR>" "Error: " (string error-no) " " error-txt "<BR></H1></HTML>")) (set 'buffer (append header message )) (net-send connection buffer)) (context 'MAIN) ### MAIN ENTRY POINT ### (set 'params (main-args)) (if (< (length params) 3) (begin (print "USAGE: httpd portNumber rootDirectory\n") (exit))) (print (HTTPD:startServer (nth 2 params) (nth 3 params))) (exit) # eof