Changeset 20918 in project


Ignore:
Timestamp:
10/21/10 20:36:41 (9 years ago)
Author:
sjamaan
Message:

spiffy: Small refactoring of two RECEIVEs into one let*-values. Add some more debugging info to those "SHOULD NEVER HAPPEN" unhandled exceptions cases

File:
1 edited

Legend:

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

    r20804 r20918  
    511511                      (bind-address (server-bind-address)))
    512512  (parameterize ((load-verbose #f))
     513    ;; This thing is way too ugly and long for its own good
    513514    (letrec ((thread-count (make-mutex/value 'thread-count 0))
    514515             (thread-stopped! (make-condition-variable 'thread-stopped!))
     
    523524                             thread-stopped!)
    524525                (handle-exceptions ; Catch errors during TCP/SSL handshake
    525                     e (void)
    526                     (receive (in out)
    527                       (if (ssl-listener? listener)
    528                           (ssl-accept listener)
    529                           (tcp-accept listener))
     526                    e (log-to (debug-log)
     527                              "~A: ~A handshake error: ~S"
     528                              (thread-name (current-thread))
     529                              (if (ssl-listener? listener) "SSL" "TCP")
     530                              ((condition-property-accessor
     531                                'exn 'message "(no message)") e))
     532                    (let*-values (((in out) (if (ssl-listener? listener)
     533                                                (ssl-accept listener)
     534                                                (tcp-accept listener)))
     535                                  ((local remote) (tcp-addresses
     536                                                   (if (ssl-port? in)
     537                                                       (ssl-port->tcp-port in)
     538                                                       in))))
     539                      (log-to (debug-log)
     540                              "~A: incoming request from ~A"
     541                              (thread-name (current-thread)) remote)
    530542                      (mutex-update! thread-count add1)
    531543                      (thread-start!
     
    533545                         ;; thread-count _must_ be updated, so trap all exns
    534546                         (handle-exceptions
    535                              e (void)
    536                              (receive (local remote)
    537                                (tcp-addresses (if (ssl-port? in)
    538                                                   (ssl-port->tcp-port in)
    539                                                   in))
     547                             e (log-to (debug-log)
     548                                       "~A: Uncaught exn: ~S (SHOULD NOT HAPPEN!)"
     549                                       (thread-name (current-thread))
     550                                       ((condition-property-accessor
     551                                         'exn 'message "(no message)") e))
     552                             ;; This won't change during the session
     553                             (parameterize ((remote-address remote)
     554                                            (local-address local)
     555                                            (secure-connection? (ssl-port? in))
     556                                            (handle-another-request? #t))
     557                               (let handle-next-request ()
     558                                 (when (handle-incoming-request in out)
     559                                   (log-to (debug-log)
     560                                           "~A: kept alive"
     561                                           (thread-name (current-thread)))
     562                                   (handle-next-request)))
    540563                               (log-to (debug-log)
    541                                        "~A: incoming request from ~A"
    542                                        (thread-name (current-thread)) remote)
    543                                ;; This won't change during the session
    544                                (parameterize ((remote-address remote)
    545                                               (local-address local)
    546                                               (secure-connection?
    547                                                (ssl-port? in))
    548                                               (handle-another-request? #t))
    549                                  (let handle-next-request ()
    550                                    (when (handle-incoming-request in out)
    551                                      (log-to (debug-log)
    552                                              "~A: kept alive"
    553                                              (thread-name (current-thread)))
    554                                      (handle-next-request)))
    555                                  (log-to (debug-log)
    556                                          "~A: closing off"
    557                                          (thread-name (current-thread)))
    558                                  (close-input-port in)
    559                                  (close-output-port out))))
     564                                       "~A: closing off"
     565                                       (thread-name (current-thread)))
     566                               (close-input-port in)
     567                               (close-output-port out)))
    560568                         (mutex-update! thread-count sub1)
    561569                         ;; Wake up the accepting thread if it's asleep
    562                          (condition-variable-signal! thread-stopped!)))))
    563                 (accept-next-connection))))
     570                         (condition-variable-signal! thread-stopped!))))
     571                    (accept-next-connection)))))
    564572     
    565573      (when (and ssl-pemfile ssl-keyfile) ; Load keys before dropping privs
Note: See TracChangeset for help on using the changeset viewer.