Author: iratqq
Date: Fri Feb 20 05:07:26 2009
New Revision: 5862
Modified:
trunk/scm/http-client.scm
trunk/scm/im-custom.scm
Log:
* scm/im-custom.scm (http-timeout):
- New custom variable.
* scm/http-client.scm (http:socket-ready?):
- New function.
(http:get):
- Check timeout.
Modified: trunk/scm/http-client.scm
==============================================================================
--- trunk/scm/http-client.scm (original)
+++ trunk/scm/http-client.scm Fri Feb 20 05:07:26 2009
@@ -58,6 +58,19 @@
(fd s)))))
res))))))))
+(define (http:socket-ready? port)
+ (let* ((fd (fd? port))
+ (fds (list (cons fd (assq-cdr '$POLLIN poll-flags-alist))))
+ (ret (file-poll fds http-timeout)))
+ (cond ((not ret)
+ (uim-notify-fatal "socket error")
+ #f)
+ ((null? ret)
+ (uim-notify-info "socket timeout")
+ #f)
+ (else
+ #t))))
+
(define (http:encode-uri-string str)
(define
hex '("0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F"))
(define (hex-format2 x)
@@ -208,16 +221,17 @@
(lambda (port)
(and-let* ((request (http:make-get-request-string hostname path
servname proxy request-alist))
(nr (file-display request port))
+ (ready? (http:socket-ready? port))
(proxy-header (if proxy
(http:read-header port)
'()))
(header (http:read-header port))
(parsed-header (http:parse-header header)))
+ (let ((content-length (http:content-length? parsed-header)))
+ (cond (content-length
+ (file-read-buffer port content-length))
+ ((http:chunked? parsed-header)
+ (http:read-chunk port))
+ (else
+ (file-get-buffer port))))))))))
- (let ((content-length (http:content-length? parsed-header)))
- (cond (content-length
- (file-read-buffer port content-length))
- ((http:chunked? parsed-header)
- (http:read-chunk port))
- (else
- (file-get-buffer port))))))))))
Modified: trunk/scm/im-custom.scm
==============================================================================
--- trunk/scm/im-custom.scm (original)
+++ trunk/scm/im-custom.scm Fri Feb 20 05:07:26 2009
@@ -623,5 +623,11 @@
(eq? http-proxy-setting
'user)))
+(define-custom 'http-timeout 3000
+ '(http)
+ '(integer 0 65535)
+ (N_ "Timeout")
+ (N_ "Timeout of http connection (msec)."))
+
(if custom-full-featured?
(for-each require-module installed-im-module-list))
