ADD: with-locale to fix the time string bug.
[glow:ragnarok.git] / ragnarok / protocol / http / request.scm
1 ;;  Copyright (C) 2011-2012  
2 ;;      "Mu Lei" known as "NalaGinrut" <NalaGinrut@gmail.com>
3 ;;  Ragnarok is free software: you can redistribute it and/or modify
4 ;;  it under the terms of the GNU General Public License as published by
5 ;;  the Free Software Foundation, either version 3 of the License, or
6 ;;  (at your option) any later version.
7
8 ;;  Ragnarok is distributed in the hope that it will be useful,
9 ;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
10 ;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11 ;;  GNU General Public License for more details.
12
13 ;;  You should have received a copy of the GNU General Public License
14 ;;  along with this program.  If not, see <http://www.gnu.org/licenses/>.
15
16 (define-module (ragnarok protocol http request)
17   #:use-module (ragnarok utils)
18   #:use-module (srfi srfi-9)
19   #:export (request-read))
20
21 (define read-line (@ (ice-9 rdelim) read-line))
22
23 (define request-read
24   (lambda (conn-socket)
25     (call-with-values 
26         (lambda ()
27           (parse-first-line conn-socket))
28       (lambda (method file qstr version)
29         (let ([lln
30                (let lp ((lns '())) ;; parse left lines
31                  (let ([ln (read-line conn-socket)])
32                    (if (eof-object? ln)
33                        lns
34                        (let ([ll (map string-trim-both 
35                                       (string-split ll #\:))])
36                          (lp (cons ll lns))
37                          ))))])
38           (make-request-type method file qstr version lln))))))
39
40 (define-record-type http-request
41   (make-request-type method file qstr version)
42   http-request?
43   (method request:method)
44   (file request:file)
45   (qstr request:query-string) 
46   (version request:version)
47   (headers request:headers)
48   )
49   
50 (define parse-first-line
51   (lambda (port)
52     (let* ([fln (read-line port)]
53            [ll (get-word-list fln)]
54            [method (list-ref ll 0)]
55            [target (list-ref ll 1)]
56            [proto (list-ref ll 2)]
57            [tl (string-split target #\?)]
58            [file (car tl)]
59            [qstr (cadr tl)]
60            [version (cadr (string-split proto #\/))] 
61            )
62       (values method file qstr version)
63       )))
64
65
66