add libra demo

theschemer · Feb 26, 2018 · 82a5044 · 82a5044
1 parent 787058b
commit 82a5044
Show file tree

Hide file tree

Showing 11 changed files with 133 additions and 72 deletions.
diff --git 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
@@ -0,0 +1,5 @@
+#hello {
+    text-align: center;
+    padding-top: 26%;
+    font-size: 50px;
+}
diff --git a/libra/demo/Content/images/favicon.ico b/libra/demo/Content/images/favicon.ico
diff --git a/libra/demo/Content/js/app.js b/libra/demo/Content/js/app.js
@@ -0,0 +1,8 @@
+$(function(){
+    $.ajax({
+        url: "/blog/libra/17",
+        success: function(data){
+            $('.name').html(data.name);
+        }
+    });
+})
diff --git a/libra/demo/app.ss 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
@@ -0,0 +1,18 @@
+<!DOCTYPE html>
+<html lang="en">
+<head>
+    <meta charset="UTF-8">
+    <meta name="viewport" content="width=device-width, initial-scale=1.0">
+    <meta http-equiv="X-UA-Compatible" content="ie=edge">
+    <link rel="icon" href="/content/images/favicon.ico" type="image/x-icon" />
+    <link rel="stylesheet" href="/content/css/index.css" type="text/css">
+    <title>Libra</title>
+</head>
+<body>
+    <div id="hello">
+        Hello <span class="name"></span>
+    </div>
+    <script src="http://lib.sinaapp.com/js/jquery/2.0.2/jquery-2.0.2.min.js"></script>
+    <script src="/content/js/app.js"></script>
+</body>
+</html>
diff --git a/libra/libra.sls b/libra/libra.sls
@@ -2,22 +2,31 @@
     (export
         get!
         post!
-        default-make-response
         router!
+        default-make-response
+        default-make-json 
+        view
+        params-ref
         libra:run)
     (import
         (scheme)
         (except (surfage s13 strings)
             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 → libra/mime.sc b/libra/mime.ss → libra/mime.sc
diff --git 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,37 +171,40 @@
 ;;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)))
 			(http:error-page 405 "Method Not Allowed" (html:plain request-line)))
 		((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
@@ -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"))
-;       "<div>test</div>"))))
+;       "<div>hello</div>"))))
 
 ; (tiny:run serve-proc port ip)
diff --git 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"))