diff --git a/demo.ss b/demo.ss index b5031b1..911419c 100644 --- a/demo.ss +++ b/demo.ss @@ -1,7 +1,7 @@ (import (libra libra)) (get! "/" - (lambda (p) (default-make-response "GET request"))) + (lambda (p) (default-make-response "GET request"))) (post! "/" (lambda (p) (default-make-response "POST request"))) diff --git a/libra/demo/Content/css/index.css b/libra/demo/Content/css/index.css new file mode 100644 index 0000000..714ae78 --- /dev/null +++ b/libra/demo/Content/css/index.css @@ -0,0 +1,5 @@ +#hello { + text-align: center; + padding-top: 26%; + font-size: 50px; +} \ No newline at end of file diff --git a/libra/demo/Content/images/favicon.ico b/libra/demo/Content/images/favicon.ico new file mode 100644 index 0000000..2d8bb52 Binary files /dev/null and b/libra/demo/Content/images/favicon.ico differ diff --git a/libra/demo/Content/js/app.js b/libra/demo/Content/js/app.js new file mode 100644 index 0000000..c6c2a06 --- /dev/null +++ b/libra/demo/Content/js/app.js @@ -0,0 +1,8 @@ +$(function(){ + $.ajax({ + url: "/blog/libra/17", + success: function(data){ + $('.name').html(data.name); + } + }); +}) \ No newline at end of file diff --git a/libra/demo/app.ss b/libra/demo/app.ss new file mode 100644 index 0000000..49ed4a3 --- /dev/null +++ b/libra/demo/app.ss @@ -0,0 +1,22 @@ +(import (libra libra)) + +(get! "/" + (lambda (p) + ; (view "./views/index.html") + (view "index"))) + +(post! "/" + (lambda (p) (default-make-response "POST request"))) + +(get! "/blog/:user/:age" + (lambda (p) + (default-make-json p))) + +(libra:run 8011) + + + + + + + diff --git a/libra/demo/views/index.html b/libra/demo/views/index.html new file mode 100644 index 0000000..fc4d28f --- /dev/null +++ b/libra/demo/views/index.html @@ -0,0 +1,18 @@ + + + + + + + + + Libra + + +
+ Hello +
+ + + + \ No newline at end of file diff --git a/libra/libra.sls b/libra/libra.sls index 962bc45..f89e8d6 100644 --- a/libra/libra.sls +++ b/libra/libra.sls @@ -2,8 +2,11 @@ (export get! post! - default-make-response router! + default-make-response + default-make-json + view + params-ref libra:run) (import (scheme) @@ -11,13 +14,19 @@ string-for-each string-fill! string-copy string->list string-copy! string-titlecase string-upcase string-downcase string-hash) + (libc libc) (irregex irregex) (json json) - (libc libc) (libra mime) (libra server http-cgi) (libra server tiny)) + ;; 路由哈希表 + (define router-handler (make-hashtable string-hash string=?)) + + ;; 配置字典 + (define libra-options (make-hashtable string-hash string=?)) + ;; 定义http方法函数 (define (get! url handler) (router! "get" url handler)) (define (post! url handler) (router! "post" url handler)) @@ -30,9 +39,6 @@ '(("Content-Type" . "text/html") ("Connection" . "close")) html)) - ;; 路由哈希表 - (define router-handler (make-hashtable string-hash string=?)) - ;; 定义路由函数 (define (router! method url handler) ;; url 转化成 regex和key-list @@ -71,7 +77,7 @@ (let loop ((index 0)) (begin (let [(reg-router (vector-ref router-vector index))] - ;; (printf (format "~a\n" reg-router)) + ; (printf "~a\n" reg-router) (if (string-index reg-router #\?) (begin (let ((values (libra-regex-router reg-router router))) @@ -159,7 +165,7 @@ ;; 返回视图函数 (define view (lambda (file-name) - (if (eq? #f (string-index file-name #\.)) + (unless (string-index file-name #\.) (set! file-name (string-append (hashtable-ref libra-options "web-path" (get-app-path)) "/" @@ -189,47 +195,40 @@ ;; 返回资源文件 (define (default-make-resource request) - 0 - ; (let ((file-path (get-file-path request))) - ; (if (file-exists? file-path) - ; (begin - ; (display (string-append - ; (http:status-line 200 "OK") - ; (http:header - ; (list - ; (get-content-type (substring request (+ 1 (string-index-right request #\.)) (string-length request))) - ; (cons "Content-Length" (number->string (get-file-length file-path))) - ; (cons "Connection" "close") - ; ) - ; ) - ; ) - ; oport - ; ) - ; (let ((f (c-fopen file-path "rb")) - ; (buf (cffi-alloc 1024))) - ; (let loop ((len (c-fread buf 1 1024 f))) - ; (if (> len 0) - ; (begin - ; (cwrite-all port buf len) - ; (loop (c-fread buf 1 1024 f))) - ; (c-fclose f))) - ; (cffi-free buf) - ; ) - ; '() - ; ) - ; '(404 "Bad Request") - ; ) - ; ) + (let* ([file-path (get-file-path request)] + [exist? (file-exists? file-path)]) + (if exist? + (let* ([flen (get-file-length file-path)] + [line (string-append + (http:status-line 200 "OK") + (http:header + (list + (get-content-type (substring request (+ 1 (string-index-right request #\.)) (string-length request))) + (cons "Content-Length" (number->string flen)) + (cons "Connection" "close"))))] + [lbv (string->utf8 line)] + [llen (bytevector-length lbv)] + [fbuf (make-bytevector flen)] + [f (c-fopen file-path "r")] + [fr (c-fread fbuf flen 1 f)] + [buf (make-bytevector (+ llen flen))]) + (bytevector-copy! lbv 0 buf 0 llen) + (bytevector-copy! fbuf 0 buf llen flen) + (c-fclose f) + buf + ) + '(404 "Bad Request") + ) + ) ) ;; 获取文件长度 (define (get-file-length file-path) - (define length 0) - (let ([p (open-input-file file-path)]) - (set! length (file-length p)) + (let* ([p (open-input-file file-path)] + [len (file-length p)]) (close-port p) + len ) - length ) ;; 获取执行文件文件夹地址 @@ -244,22 +243,13 @@ ) ) - - ;; 配置字典 - (define libra-options (make-hashtable string-hash string=?)) - ;; 展示字典 - (define (show-options) - (vector-map (lambda (k) (display (string-append k ": " (hashtable-ref libra-options k ""))) (newline)) (hashtable-keys libra-options)) + (define (hashtable-show ht) + (vector-map + (lambda (k) (printf "~a : ~a\n" k (hashtable-ref ht k ""))) + (hashtable-keys ht)) ) - ;; web根目录 - (hashtable-set! libra-options "web-path" (get-app-path)) - ;; 视图文件夹名称 - (hashtable-set! libra-options "view-path" "views") - ;; 启动文件目录 - (hashtable-set! libra-options "app-path" (get-app-path)) - ;; 获取web配置 (define (get-option key . rest) (hashtable-ref libra-options key (if (null? rest) #f (car rest)))) @@ -285,6 +275,18 @@ ) ) + ;; 初始化操作 + (define libra-init + (begin + ;; web根目录 + (hashtable-set! libra-options "web-path" (get-app-path)) + ;; 视图文件夹名称 + (hashtable-set! libra-options "view-path" "views") + ;; 启动文件目录 + (hashtable-set! libra-options "app-path" (get-app-path)) + 0 + ) + ) ;; 默认服务器处理 入口 (define libra-proc diff --git a/libra/mime.ss b/libra/mime.sc similarity index 100% rename from libra/mime.ss rename to libra/mime.sc diff --git a/libra/server/http-cgi.scm b/libra/server/http-cgi.scm index c137b41..fc9e761 100644 --- a/libra/server/http-cgi.scm +++ b/libra/server/http-cgi.scm @@ -139,11 +139,10 @@ ;;and any additional @3 @dots{}; with @var{*http:byline*} or SLIB's ;;default at the bottom. (define (http:error-page status-code reason-phrase . html-strings) - (define byline - (or - *http:byline* - "Libra HTTP/1.0 server" - )) + (define byline + (or + *http:byline* + "Libra HTTP/1.0 Server")) (string-append (http:status-line status-code reason-phrase) (http:content @@ -172,18 +171,19 @@ ;;Otherwise, @0 replies (to @3) with appropriate HTML describing the ;;problem. (define (http:serve-query serve-proc client-socket) - (let* ([input-port (make-input-port (lambda x (void)) (socket:read client-socket))] + (let* ([input-port (make-input-port (lambda x (void)) (utf8->string (socket:read client-socket)))] [request-line (http:read-request-line input-port)] [header (and request-line (http:read-header input-port))] [query-string (and header (http:read-query-string - request-line header input-port))]) - (socket:write client-socket (http:service serve-proc request-line query-string header)))) + request-line header input-port))] + [rst (http:service serve-proc request-line query-string header)]) + (socket:write client-socket (if (bytevector? rst) rst (string->utf8 rst))))) (define (http:service serve-proc request-line query-string header) (cond ((not request-line) - (http:error-page 400 "Bad Request.")) + (http:error-page 400 "Bad Request.")) ((string? (car request-line)) (http:error-page 501 "Not Implemented" (html:plain request-line))) ((not (memq (car request-line) '(get post))) @@ -191,18 +191,20 @@ ((serve-proc request-line query-string header) => (lambda (reply) (cond + ((bytevector? reply) + reply) ((string? reply) (string-append (http:status-line 200 "OK") - reply)) + reply)) ((and (pair? reply) (list? reply)) (if (number? (car reply)) (apply http:error-page reply) (apply http:error-page (cons 500 reply)))) (else (http:error-page 500 "Internal Server Error"))))) - ((not query-string) - (http:error-page 400 "Bad Request" (html:plain request-line))) - (else - (http:error-page 500 "Internal Server Error" (html:plain header))))) + ((not query-string) + (http:error-page 400 "Bad Request" (html:plain request-line))) + (else + (http:error-page 500 "Internal Server Error" (html:plain header))))) (define (http:read-start-line port) (do ((line (read-line port) (read-line port))) diff --git a/libra/server/tiny.sc b/libra/server/tiny.sc index 9cff7c2..4e08ba4 100644 --- a/libra/server/tiny.sc +++ b/libra/server/tiny.sc @@ -17,6 +17,7 @@ (let ([server (socket:socket AF_INET SOCK_STREAM IPPROTO_IP)]) (socket:bind server AF_INET ip port) (socket:listen server) + (printf "Libra Listening on ~a:~a\n" ip port) (let loop ([client (socket:accept server)]) (when (>= client 0) (if threads? @@ -49,6 +50,6 @@ ; (string-append ; (http:content ; '(("Content-Type" . "text/html")) -; "
test
")))) +; "
hello
")))) ; (tiny:run serve-proc port ip) \ No newline at end of file diff --git a/package.sc b/package.sc index 3c97095..8f6b337 100644 --- a/package.sc +++ b/package.sc @@ -10,6 +10,9 @@ ("scripts" ("run" . "scheme --script")) ("dependencies" + ("libc" . "0.1.2") + ("socket" . "0.1.1") ("irregex" . "0.9.6") - ("json" . "0.5.1")) + ("json" . "0.5.1") + ("surfage" . "0.1.0")) ("devDependencies")) \ No newline at end of file