Changeset 18109 in project


Ignore:
Timestamp:
05/18/10 03:11:55 (9 years ago)
Author:
mario
Message:

awful (trunk): when a page is defined and bound to the "/foo" path and a
"/foo" directory exists on the (root-path), awful do the following:

  • if there's an index file under "/foo", awful displays the index file
  • if there's no index file under "/foo", awful calls the procedure bound

to "/foo"

This change allows a directory "/foo" and a procedure bound to "/foo" to
coexist. Previously, we'd get a 403 when trying to access the "/foo"
directory even when there was a procedure bound to "/foo".

File:
1 edited

Legend:

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

    r18049 r18109  
    227227              (proc (resource-ref path (root-path))))
    228228         (if proc
    229              (let ((out (->string (proc path))))
    230                (with-headers `((content-type text/html)
    231                                (content-length ,(string-length out)))
    232                              (lambda ()
    233                                (write-logged-response)
    234                                (unless (eq? 'HEAD (request-method (current-request)))
    235                                  (display out (response-port (current-response)))))))
     229             (run-resource proc path)
    236230             (old-handler _)))))))
     231
     232(define (run-resource proc path)
     233  (let ((out (->string (proc path))))
     234    (with-headers `((content-type text/html)
     235                    (content-length ,(string-length out)))
     236                  (lambda ()
     237                    (write-logged-response)
     238                    (unless (eq? 'HEAD (request-method (current-request)))
     239                      (display out (response-port (current-response))))))))
    237240
    238241(define (resource-ref path vhost-root-path #!optional check-existence)
     
    268271
    269272;;; Root dir
     273(define (redirect-to dest)
     274  (parameterize
     275    ((current-response
     276      (update-response
     277       (current-response)
     278       code: 302
     279       headers: (headers `((location ,dest)
     280                           (content-length 0))
     281                         (response-headers (current-response))))))
     282    (write-logged-response)))
     283
    270284(define (register-root-dir-handler)
    271285  (handle-directory
    272286   (let ((old-handler (handle-directory)))
    273287     (lambda (path)
    274        (if (equal? path "/") ;; redirect to (main-page-path)
    275            (parameterize
    276                ((current-response
    277                  (update-response
    278                   (current-response)
    279                   code: 302
    280                   headers: (headers `((location ,(main-page-path))
    281                                       (content-length 0))
    282                                     (response-headers (current-response))))))
    283              (write-logged-response))
    284            (old-handler path))))))
    285 
     288       (cond ((equal? path "/")
     289              (redirect-to (main-page-path)))
     290             ((resource-ref path (root-path))
     291              => (cut run-resource <> path))
     292             (else (old-handler path)))))))
    286293
    287294;;; Pages
Note: See TracChangeset for help on using the changeset viewer.