Changeset 17967 in project


Ignore:
Timestamp:
04/29/10 12:40:40 (9 years ago)
Author:
Mario Domenech Goulart
Message:

awful.scm (trunk)

  • support for regex-based page paths
  • main-page-path redirection made with code stolen from spiffy's

send-response (still in trunk).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/awful/trunk/awful.scm

    r17509 r17967  
    109109  (unless (enable-reload)
    110110    (add-resource! (reload-path)
    111                    (root-path)
    112                    (lambda () (load-apps apps))))
     111                   (root-path)
     112                   (lambda () (load-apps apps))))
    113113  (reload-message))
    114114
    115115(define awful-start start-server)
     116
    116117
    117118;;; Javascript
     
    124125(define (maybe-compress-javascript js no-javascript-compression)
    125126  (if (and (enable-javascript-compression)
    126            (javascript-compressor)
    127            (not no-javascript-compression))
     127           (javascript-compressor)
     128           (not no-javascript-compression))
    128129      (string-trim-both ((javascript-compressor) js))
    129130      js))
     
    135136    (with-output-to-file (debug-file)
    136137      (lambda ()
    137         (print (concat args)))
     138        (print (concat args)))
    138139      append:)))
    139140
     
    150151  (if (list? var)
    151152      (for-each (lambda (var/val)
    152                   (session-set! (sid) (string->symbol* (car var/val)) (cdr var/val)))
    153                 var)
     153                  (session-set! (sid) (string->symbol* (car var/val)) (cdr var/val)))
     154                var)
    154155      (session-set! (sid) (string->symbol* var) val)))
    155156
     
    162163(define (link url text . rest)
    163164  (let ((use-session? (and (sid)
    164                            (session-valid? (sid))
    165                            (not (get-keyword no-session: rest))))
    166         (arguments (or (get-keyword arguments: rest) '()))
    167         (separator (or (get-keyword separator: rest) ";&")))
     165                           (session-valid? (sid))
     166                           (not (get-keyword no-session: rest))))
     167        (arguments (or (get-keyword arguments: rest) '()))
     168        (separator (or (get-keyword separator: rest) ";&")))
    168169    (apply <a>
    169            (append
    170             (list href: (if url
    171                             (++ url
    172                                 (if (or use-session? (not (null? arguments)))
    173                                     (++ "?"
    174                                         (form-urlencode
    175                                         (append arguments
    176                                                 (if use-session?
    177                                                      `((sid . ,(sid)))
    178                                                      '()))
    179                                         separator: separator))
    180                                     ""))
    181                             "#"))
    182             rest
    183             (list text)))))
     170           (append
     171            (list href: (if url
     172                            (++ url
     173                                (if (or use-session? (not (null? arguments)))
     174                                    (++ "?"
     175                                        (form-urlencode
     176                                        (append arguments
     177                                                (if use-session?
     178                                                     `((sid . ,(sid)))
     179                                                     '()))
     180                                        separator: separator))
     181                                    ""))
     182                            "#"))
     183            rest
     184            (list text)))))
    184185
    185186(define (form contents . rest)
    186187  (let ((use-session? (and (sid)
    187                            (session-valid? (sid))
    188                            (not (get-keyword no-session: rest)))))
     188                           (session-valid? (sid))
     189                           (not (get-keyword no-session: rest)))))
    189190    (apply <form>
    190            (append rest
    191                    (list
    192                     (++ (if use-session?
    193                             (hidden-input 'sid (sid))
    194                             "")
    195                         contents))))))
     191           (append rest
     192                   (list
     193                    (++ (if use-session?
     194                            (hidden-input 'sid (sid))
     195                            "")
     196                        contents))))))
    196197
    197198
     
    228229     (lambda (_)
    229230       (let* ((path-list (uri-path (request-uri (current-request))))
    230               (path (if (null? (cdr path-list))
    231                         (car path-list)
    232                         (++ "/" (concat (cdr path-list) "/"))))
    233               (proc (resource-ref path (root-path))))
    234          (if proc
    235              (let ((out (->string (proc))))
    236                (with-headers `((content-type text/html)
    237                                (content-length ,(string-length out)))
    238                              (lambda ()
    239                                (write-logged-response)
    240                                (unless (eq? 'HEAD (request-method (current-request)))
    241                                  (display out (response-port (current-response)))))))
    242              (old-handler _)))))))
    243 
    244 (define (resource-ref path vhost-root-path #!optional default)
    245   (hash-table-ref/default *resources* (cons path vhost-root-path) default))
    246 
    247 (define (resource-exists? path vhost-root-path)
    248   (not (not (resource-ref path vhost-root-path))))
     231              (path (if (null? (cdr path-list))
     232                        (car path-list)
     233                        (++ "/" (concat (cdr path-list) "/"))))
     234              (proc (resource-ref path (root-path))))
     235         (if proc
     236             (let ((out (->string (proc path))))
     237               (with-headers `((content-type text/html)
     238                               (content-length ,(string-length out)))
     239                             (lambda ()
     240                               (write-logged-response)
     241                               (unless (eq? 'HEAD (request-method (current-request)))
     242                                 (display out (response-port (current-response)))))))
     243             (old-handler _)))))))
     244
     245(define (resource-ref path vhost-root-path #!optional check-existence)
     246  (or (hash-table-ref/default *resources* (cons path vhost-root-path) #f)
     247      (resource-match path vhost-root-path check-existence)))
     248
     249(define (resource-match path vhost-root-path #!optional check-existence)
     250  ;; When `check-existence' is #f, `resource-match' will try to
     251  ;; actually match the given path and the path from `*resources*',
     252  ;; instead of just checking whether they are equal.
     253  (let loop ((resources (hash-table->alist *resources*)))
     254    (if (null? resources)
     255        #f
     256        (let* ((current-resource (car resources))
     257               (current-path (caar current-resource))
     258               (current-vhost (cdar current-resource))
     259               (current-proc (cdr current-resource)))
     260          (if (and (regexp? current-path)
     261                   (equal? current-vhost vhost-root-path)
     262                   (if check-existence
     263                       (equal? current-path path)
     264                       (string-match current-path path)))
     265              current-proc
     266              (loop (cdr resources)))))))
     267
     268(define (resource-exists? path vhost-root-path #!optional check-existence)
     269  (not (not (resource-ref path vhost-root-path check-existence))))
    249270
    250271(define (add-resource! path vhost-root-path proc)
    251   (unless (resource-exists? path vhost-root-path)
     272  (unless (resource-exists? path vhost-root-path 'check-existence)
    252273    (hash-table-set! *resources* (cons path vhost-root-path) proc)))
    253274
     
    258279   (let ((old-handler (handle-directory)))
    259280     (lambda (path)
    260        (if (equal? path "/")
    261            (let ((data (html-page
    262                         ""
    263                         headers: (<meta> http-equiv: "refresh" content: (++ "0;url=" (main-page-path))))))
    264              (with-headers `((content-type text/html)
    265                              (content-length ,(string-length data)))
    266                            (lambda ()
    267                              (write-logged-response)
    268                              (unless (eq? 'HEAD (request-method (current-request)))
    269                                (display data (response-port (current-response)))))))
    270            (old-handler path))))))
     281       (if (equal? path "/") ;; redirect to (main-page-path)
     282           (parameterize
     283               ((current-response
     284                 (update-response
     285                  (current-response)
     286                  code: 302
     287                  headers: (headers `((location ,(main-page-path))
     288                                      (content-length 0))
     289                                    (response-headers (current-response))))))
     290             (write-logged-response))
     291           (old-handler path))))))
    271292
    272293
    273294;;; Pages
    274295(define (define-page path contents #!key css title doctype headers charset no-ajax
    275                      no-template no-session no-db vhost-root-path no-javascript-compression
    276                      use-session) ;; for define-session-page
    277   (let ((path (make-pathname (app-root-path) path)))
     296                     no-template no-session no-db vhost-root-path no-javascript-compression
     297                     use-session) ;; for define-session-page
     298  (let ((path (if (regexp? path)
     299                  path
     300                  (make-pathname (app-root-path) path))))
    278301    (add-resource!
    279302     path
    280303     (or vhost-root-path (root-path))
    281      (lambda ()
     304     (lambda (#!optional given-path)
    282305       (http-request-variables (request-vars))
    283306       (sid ($ 'sid))
    284307       (when (and (db-credentials) (db-enabled?) (not no-db))
    285         (db-connection ((db-connect) (db-credentials))))
     308        (db-connection ((db-connect) (db-credentials))))
    286309       (page-javascript "")
    287310       (awful-refresh-session!)
    288311       (let ((out
    289               (if (or (not (enable-session))
    290                       no-session
    291                       use-session
    292                       (and (enable-session) (session-valid? (sid))))
    293                   (if (or no-session (not (enable-session)) ((page-access-control) path))
    294                       (begin
    295                         (when use-session
    296                           (if (session-valid? (sid))
    297                               (awful-refresh-session!)
    298                               (sid (session-create))))
    299                         (let ((contents
    300                                (handle-exceptions
    301                                 exn
    302                                 (begin
    303                                   (debug (with-output-to-string
    304                                            (lambda ()
    305                                              (print-call-chain)
    306                                              (print-error-message exn))))
    307                                   ((page-exception-message) exn))
    308                                 (contents))))
    309                           (if no-template
    310                               contents
    311                               ((page-template)
    312                                contents
    313                                css: (or css (page-css))
    314                                title: title
    315                                doctype: (or doctype (page-doctype))
    316                                headers: (++ (if (or no-ajax (not (ajax-library)) (not (enable-ajax)))
    317                                                 ""
    318                                                 (<script> type: "text/javascript"
    319                                                           src: (ajax-library)))
    320                                             (or headers "")
    321                                             (if (or no-ajax
    322                                                     (not (enable-ajax))
    323                                                     (not (ajax-library)))
    324                                                 (if (string-null? (page-javascript))
    325                                                     ""
    326                                                     (<script> type: "text/javascript"
    327                                                               (maybe-compress-javascript
    328                                                                (page-javascript)
    329                                                                no-javascript-compression)))
    330                                                 (<script> type: "text/javascript"
    331                                                           (maybe-compress-javascript
    332                                                            (++ "$(document).ready(function(){"
    333                                                                (page-javascript) "});")
    334                                                            no-javascript-compression))))
    335                                charset: (or charset (page-charset))))))
    336                       ((page-template) ((page-access-denied-message) path)))
    337                   ((page-template)
    338                    ""
    339                    headers: (<meta> http-equiv: "refresh"
    340                                     content: (++ "0;url=" (login-page-path)
    341                                                  "?reason=invalid-session&attempted-path=" path
    342                                                  "&user=" ($ 'user "")))))))
    343          (when (and (db-connection) (db-enabled?) (not no-db)) ((db-disconnect) (db-connection)))
    344          out)))))
     312              (if (or (not (enable-session))
     313                      no-session
     314                      use-session
     315                      (and (enable-session) (session-valid? (sid))))
     316                  (if (or no-session (not (enable-session)) ((page-access-control) path))
     317                      (begin
     318                        (when use-session
     319                          (if (session-valid? (sid))
     320                              (awful-refresh-session!)
     321                              (sid (session-create))))
     322                        (let ((contents
     323                               (handle-exceptions
     324                                exn
     325                                (begin
     326                                  (debug (with-output-to-string
     327                                           (lambda ()
     328                                             (print-call-chain)
     329                                             (print-error-message exn))))
     330                                  ((page-exception-message) exn))
     331                                (if (regexp? path)
     332                                    (contents given-path)
     333                                    (contents)))))
     334                          (if no-template
     335                              contents
     336                              ((page-template)
     337                               contents
     338                               css: (or css (page-css))
     339                               title: title
     340                               doctype: (or doctype (page-doctype))
     341                               headers: (++ (if (or no-ajax (not (ajax-library)) (not (enable-ajax)))
     342                                                ""
     343                                                (<script> type: "text/javascript"
     344                                                          src: (ajax-library)))
     345                                            (or headers "")
     346                                            (if (or no-ajax
     347                                                    (not (enable-ajax))
     348                                                    (not (ajax-library)))
     349                                                (if (string-null? (page-javascript))
     350                                                    ""
     351                                                    (<script> type: "text/javascript"
     352                                                              (maybe-compress-javascript
     353                                                               (page-javascript)
     354                                                               no-javascript-compression)))
     355                                                (<script> type: "text/javascript"
     356                                                          (maybe-compress-javascript
     357                                                           (++ "$(document).ready(function(){"
     358                                                               (page-javascript) "});")
     359                                                           no-javascript-compression))))
     360                               charset: (or charset (page-charset))))))
     361                      ((page-template) ((page-access-denied-message) path)))
     362                  ((page-template)
     363                   ""
     364                   headers: (<meta> http-equiv: "refresh"
     365                                    content: (++ "0;url=" (login-page-path)
     366                                                 "?reason=invalid-session&attempted-path=" path
     367                                                 "&user=" ($ 'user "")))))))
     368         (when (and (db-connection) (db-enabled?) (not no-db)) ((db-disconnect) (db-connection)))
     369         out)))))
    345370
    346371(define (define-session-page path contents . rest)
     
    351376;;; Ajax
    352377(define (ajax path id event proc #!key target (action 'html) (method 'POST) (arguments '())
    353               js no-session no-db no-page-javascript vhost-root-path live)
     378              js no-session no-db no-page-javascript vhost-root-path live)
    354379  (if (enable-ajax)
    355       (let ((path (make-pathname (list (app-root-path) (ajax-namespace)) path)))
    356         (add-resource! path
    357                        (or vhost-root-path (root-path))
    358                        (lambda ()
    359                          (http-request-variables (request-vars))
    360                          (sid ($ 'sid))
    361                          (when (and (db-credentials) (db-enabled?) (not no-db))
    362                            (db-connection ((db-connect) (db-credentials))))
    363                          (awful-refresh-session!)
    364                          (if (or (not (enable-session))
    365                                  no-session
    366                                  (and (enable-session) (session-valid? (sid))))
    367                              (if ((page-access-control) path)
    368                                  (let ((out (proc)))
    369                                    (when (and (db-credentials) (db-enabled?) (not no-db))
    370                                      ((db-disconnect) (db-connection)))
    371                                    out)
    372                                  ((page-access-denied-message) path))
    373                              (ajax-invalid-session-message))))
    374         (http-request-variables (request-vars))
    375         (sid ($ 'sid))
    376         (let* ((arguments (if (or (not (enable-session))
    377                                   no-session
    378                                   (not (and (sid) (session-valid? (sid)))))
    379                               arguments
    380                               (cons `(sid . ,(++ "'" (sid) "'")) arguments)))
    381                (js (++ (page-javascript)
    382                        (if (and id event)
    383                            (let ((events (concat (if (list? event) event (list event)) " "))
    384                                  (binder (if live "live" "bind")))
    385                              (++ "$('#" (->string id) "')." binder "('" events "',"))
    386                            "")
    387                        "function(){$.ajax({type:'" (->string method) "',"
    388                        "url:'" path "',"
    389                        "success:function(h){"
    390                        (or js
    391                            (if target
    392                                (++ "$('#" target "')." (->string action) "(h);")
    393                                "return;"))
    394                        "},"
    395                        (++ "data:{"
    396                            (string-intersperse
    397                             (map (lambda (var/val)
    398                                    (conc  "'" (car var/val) "':" (cdr var/val)))
    399                                  arguments)
    400                             ",") "}")
    401                        "})}"
    402                        (if (and id event)
    403                            ");\n"
    404                            ""))))
    405           (unless no-page-javascript (page-javascript js))
    406           js))
     380      (let ((path (if (regexp? path)
     381                  path
     382                  (make-pathname (list (app-root-path) (ajax-namespace)) path))))
     383        (add-resource! path
     384                       (or vhost-root-path (root-path))
     385                       (lambda (#!optional given-path)
     386                         (http-request-variables (request-vars))
     387                         (sid ($ 'sid))
     388                         (when (and (db-credentials) (db-enabled?) (not no-db))
     389                           (db-connection ((db-connect) (db-credentials))))
     390                         (awful-refresh-session!)
     391                         (if (or (not (enable-session))
     392                                 no-session
     393                                 (and (enable-session) (session-valid? (sid))))
     394                             (if ((page-access-control) path)
     395                                 (let ((out (proc)))
     396                                   (when (and (db-credentials) (db-enabled?) (not no-db))
     397                                     ((db-disconnect) (db-connection)))
     398                                   out)
     399                                 ((page-access-denied-message) path))
     400                             (ajax-invalid-session-message))))
     401        (http-request-variables (request-vars))
     402        (sid ($ 'sid))
     403        (let* ((arguments (if (or (not (enable-session))
     404                                  no-session
     405                                  (not (and (sid) (session-valid? (sid)))))
     406                              arguments
     407                              (cons `(sid . ,(++ "'" (sid) "'")) arguments)))
     408               (js (++ (page-javascript)
     409                       (if (and id event)
     410                           (let ((events (concat (if (list? event) event (list event)) " "))
     411                                 (binder (if live "live" "bind")))
     412                             (++ "$('#" (->string id) "')." binder "('" events "',"))
     413                           "")
     414                       "function(){$.ajax({type:'" (->string method) "',"
     415                       "url:'" path "',"
     416                       "success:function(h){"
     417                       (or js
     418                           (if target
     419                               (++ "$('#" target "')." (->string action) "(h);")
     420                               "return;"))
     421                       "},"
     422                       (++ "data:{"
     423                           (string-intersperse
     424                            (map (lambda (var/val)
     425                                   (conc  "'" (car var/val) "':" (cdr var/val)))
     426                                 arguments)
     427                            ",") "}")
     428                       "})}"
     429                       (if (and id event)
     430                           ");\n"
     431                           ""))))
     432          (unless no-page-javascript (page-javascript js))
     433          js))
    407434      "")) ;; empty if no-ajax
    408435
    409436(define (periodical-ajax path interval proc #!key target (action 'html) (method 'POST)
    410                         (arguments '()) js no-session no-db vhost-root-path live)
     437                        (arguments '()) js no-session no-db vhost-root-path live)
    411438  (if (enable-ajax)
    412439      (page-javascript
    413440       (++ "setInterval("
    414            (ajax path #f #f proc
    415                 target: target
    416                 action: action
    417                 method: method
    418                 arguments: arguments
    419                 js: js
    420                 no-session: no-session
    421                 no-db: no-db
    422                 vhost-root-path: vhost-root-path
    423                 live: live
    424                 no-page-javascript: #t)
    425            ", " (->string interval) ");\n"))
     441           (ajax path #f #f proc
     442                target: target
     443                action: action
     444                method: method
     445                arguments: arguments
     446                js: js
     447                no-session: no-session
     448                no-db: no-db
     449                vhost-root-path: vhost-root-path
     450                live: live
     451                no-page-javascript: #t)
     452           ", " (->string interval) ");\n"))
    426453      ""))
    427454
    428455(define (ajax-link path id text proc #!key target (action 'html) (method 'POST) (arguments '())
    429                    js no-session no-db (event 'click) vhost-root-path live class
    430                    hreflang type rel rev charset coords shape accesskey tabindex a-target)
     456                   js no-session no-db (event 'click) vhost-root-path live class
     457                   hreflang type rel rev charset coords shape accesskey tabindex a-target)
    431458  (ajax path id event proc
    432         target: target
    433         action: action
    434         method: method
    435         arguments: arguments
    436         js: js
    437         no-session: no-session
    438         vhost-root-path: vhost-root-path
    439         live: live
    440         no-db: no-db)
     459        target: target
     460        action: action
     461        method: method
     462        arguments: arguments
     463        js: js
     464        no-session: no-session
     465        vhost-root-path: vhost-root-path
     466        live: live
     467        no-db: no-db)
    441468  (<a> href: "#"
    442469       id: id
     
    457484;;; Login form
    458485(define (login-form #!key (user-label "User: ")
    459                           (password-label "Password: ")
    460                           (submit-label "Submit")
    461                           (trampoline-path "/login-trampoline")
    462                           (refill-user #t))
     486                          (password-label "Password: ")
     487                          (submit-label "Submit")
     488                          (trampoline-path "/login-trampoline")
     489                          (refill-user #t))
    463490  (let ((attempted-path ($ 'attempted-path))
    464         (user ($ 'user)))
     491        (user ($ 'user)))
    465492    (<form> action: trampoline-path method: "post"
    466             (if attempted-path
    467                 (hidden-input 'attempted-path attempted-path)
    468                 "")
    469             (<span> id: "user-container"
    470                     (<span> id: "user-label" user-label)
    471                     (<input> type: "text" id: "user" name: "user" value: (and refill-user user)))
    472             (<span> id: "password-container"
    473                     (<span> id: "password-label" password-label)
    474                     (<input> type: "password" id: "password" name: "password"))
    475             (<input> type: "submit" id: "login-submit" value: submit-label))))
     493            (if attempted-path
     494                (hidden-input 'attempted-path attempted-path)
     495                "")
     496            (<span> id: "user-container"
     497                    (<span> id: "user-label" user-label)
     498                    (<input> type: "text" id: "user" name: "user" value: (and refill-user user)))
     499            (<span> id: "password-container"
     500                    (<span> id: "password-label" password-label)
     501                    (<input> type: "password" id: "password" name: "password"))
     502            (<input> type: "submit" id: "login-submit" value: submit-label))))
    476503
    477504
     
    481508    (lambda ()
    482509      (let* (($ (http-request-variables))
    483              (user ($ 'user))
    484              (password ($ 'password))
    485              (attempted-path ($ 'attempted-path))
    486              (password-valid? ((valid-password?) user password))
    487              (new-sid (and password-valid? (session-create))))
    488         (sid new-sid)
    489         (when hook (hook user))
    490         (html-page
    491         ""
    492         headers: (<meta> http-equiv: "refresh"
    493                           content: (++ "0;url="
    494                                        (if new-sid
    495                                            (++ (or attempted-path (main-page-path)) "?user=" user "&sid=" new-sid)
    496                                            (++ (login-page-path) "?reason=invalid-password&user=" user)))))))
     510             (user ($ 'user))
     511             (password ($ 'password))
     512             (attempted-path ($ 'attempted-path))
     513             (password-valid? ((valid-password?) user password))
     514             (new-sid (and password-valid? (session-create))))
     515        (sid new-sid)
     516        (when hook (hook user))
     517        (html-page
     518        ""
     519        headers: (<meta> http-equiv: "refresh"
     520                          content: (++ "0;url="
     521                                       (if new-sid
     522                                           (++ (or attempted-path (main-page-path)) "?user=" user "&sid=" new-sid)
     523                                           (++ (login-page-path) "?reason=invalid-password&user=" user)))))))
    497524    vhost-root-path: vhost-root-path
    498525    no-session: #t
     
    506533    (lambda ()
    507534      (if ((web-repl-access-control))
    508           (let ((web-eval
    509                 (lambda ()
    510                    (<pre> convert-to-entities?: #t
    511                           (with-output-to-string
    512                             (lambda ()
    513                               (pp (handle-exceptions
    514                                    exn
    515                                    (begin
    516                                      (print-error-message exn)
    517                                      (print-call-chain))
    518                                    (eval `(begin
    519                                             ,@(with-input-from-string ($ 'code "")
    520                                                 read-file)))))))))))
    521             (page-javascript "$('#clear').click(function(){$('#prompt').val('');});")
    522             (ajax (++ path "-eval") 'eval 'click web-eval
    523                   target: "result"
    524                   arguments: '((code . "$('#prompt').val()")))
    525 
    526             (++ (<textarea> id: "prompt" name: "prompt" rows: "6" cols: "90")
    527                 (itemize
    528                 (map (lambda (item)
    529                         (<a> href: "#" id: (car item) (cdr item)))
    530                       '(("eval"  . "Eval")
    531                         ("clear" . "Clear")))
    532                 list-id: "button-bar")
    533                 (<div> id: "result")))
    534           (web-repl-access-denied-message)))
     535          (let ((web-eval
     536                (lambda ()
     537                   (<pre> convert-to-entities?: #t
     538                          (with-output-to-string
     539                            (lambda ()
     540                              (pp (handle-exceptions
     541                                   exn
     542                                   (begin
     543                                     (print-error-message exn)
     544                                     (print-call-chain))
     545                                   (eval `(begin
     546                                            ,@(with-input-from-string ($ 'code "")
     547                                                read-file)))))))))))
     548            (page-javascript "$('#clear').click(function(){$('#prompt').val('');});")
     549            (ajax (++ path "-eval") 'eval 'click web-eval
     550                  target: "result"
     551                  arguments: '((code . "$('#prompt').val()")))
     552
     553            (++ (<textarea> id: "prompt" name: "prompt" rows: "6" cols: "90")
     554                (itemize
     555                (map (lambda (item)
     556                        (<a> href: "#" id: (car item) (cdr item)))
     557                      '(("eval"  . "Eval")
     558                        ("clear" . "Clear")))
     559                list-id: "button-bar")
     560                (<div> id: "result")))
     561          (web-repl-access-denied-message)))
    535562    title: (or title "Web REPL")
    536563    css: css))
     
    543570    (lambda ()
    544571      (if ((session-inspector-access-control))
    545           (let ((bindings (session-bindings (sid))))
    546             (if (null? bindings)
    547                 (<h2> "Session for sid " (sid) " is empty")
    548                 (++ (<h2> "Session for " (sid))
    549                     (tabularize
    550                      (map (lambda (binding)
    551                             (let ((var (car binding))
    552                                   (val (with-output-to-string
    553                                         (lambda ()
    554                                            (pp (cdr binding))))))
    555                               (list var (<pre> val))))
    556                           bindings)))))
    557           (session-inspector-access-denied-message)))
     572          (let ((bindings (session-bindings (sid))))
     573            (if (null? bindings)
     574                (<h2> "Session for sid " (sid) " is empty")
     575                (++ (<h2> "Session for " (sid))
     576                    (tabularize
     577                     (map (lambda (binding)
     578                            (let ((var (car binding))
     579                                  (val (with-output-to-string
     580                                        (lambda ()
     581                                           (pp (cdr binding))))))
     582                              (list var (<pre> val))))
     583                          bindings)))))
     584          (session-inspector-access-denied-message)))
    558585    title: (or title "Session inspector")
    559586    css: css))
Note: See TracChangeset for help on using the changeset viewer.