Revision: 6653
Author: ek.kato
Date: Mon Aug 2 22:24:42 2010
Log: * scm/process.scm
- Use srfi-2 for and-let*.
- (process-exec-failed)
- (process-dup2-failed)
- (process-fork-failed)
- New variable.
- (process-io)
- Report error to parent from child.
- Make parent returns #f when child fails.
* scm/prime.scm
- (prime-connection-init) : Set fds #f when
prime-server-setting? is unknown.
* scm/annotation-filter.scm
- (annotation-filter-open-unix-domain-socket) : Rename to
annotation-filter-open-with-unix-domain-socket.
- (annotation-filter-open-with-unix-domain-socket) : Renamed
from annotation-filter-open-unix-domain-socket.
- (annotation-filter-init) : Add check for fds.
- (annotation-filter-read-message) : Add check for return value
of file-read-line.
* scm/im-custom.scm (http-timeout)
- User friendly description.
http://code.google.com/p/uim/source/detail?r=6653
Modified:
/trunk/scm/annotation-filter.scm
/trunk/scm/im-custom.scm
/trunk/scm/prime.scm
/trunk/scm/process.scm
=======================================
--- /trunk/scm/annotation-filter.scm Mon Jun 21 18:19:54 2010
+++ /trunk/scm/annotation-filter.scm Mon Aug 2 22:24:42 2010
@@ -45,7 +45,7 @@
(define annotation-filter-socket-pair #f)
-(define (annotation-filter-open-unix-domain-socket)
+(define (annotation-filter-open-with-unix-domain-socket)
(and-let* ((fd (unix-domain-socket-connect
annotation-filter-unix-domain-socket-path)))
(cons fd fd)))
@@ -66,15 +66,20 @@
((eq? annotation-filter-server-setting? 'pipe)
(annotation-filter-open-with-pipe))
(else
- (uim-notify-fatal (N_ "Custom filter connection
is not defined"))))))
- (set! annotation-filter-socket-pair (cons (open-file-port (car
fds))
- (open-file-port (cdr
fds))))
- #t)))
+ (uim-notify-fatal (N_ "Custom filter connection
is not defined"))
+ #f))))
+ (if fds
+ (set! annotation-filter-socket-pair (cons
+ (open-file-port (car fds))
+ (open-file-port (cdr
fds))))
+ (set! annotation-filter-socket-pair #f)))))
(define (annotation-filter-read-message iport)
(let loop ((line (file-read-line iport))
(rest ""))
- (if (string=? "." line)
+ (if (or (not line)
+ (eof-object? line)
+ (string=? "." line))
rest
(loop (file-read-line iport) (string-append rest line)))))
=======================================
--- /trunk/scm/im-custom.scm Thu Jul 22 18:17:58 2010
+++ /trunk/scm/im-custom.scm Mon Aug 2 22:24:42 2010
@@ -844,7 +844,7 @@
(define-custom 'http-timeout 3000
'(http)
'(integer 0 65535)
- (N_ "Timeout")
+ (N_ "Timeout (msec)")
(N_ "Timeout of http connection (msec)."))
(load "predict-custom.scm")
=======================================
--- /trunk/scm/prime.scm Sat Jul 31 08:18:43 2010
+++ /trunk/scm/prime.scm Mon Aug 2 22:24:42 2010
@@ -867,7 +867,8 @@
((eq? prime-server-setting? 'pipe)
(prime-open-with-pipe "prime"))
(else
- (uim-notify-fatal (N_ "Prime connection is not
defined"))))))
+ (uim-notify-fatal (N_ "Prime connection is not
defined"))
+ #f))))
(if fds
(cons (open-file-port (car fds))
(open-file-port (cdr fds)))
=======================================
--- /trunk/scm/process.scm Sat Jul 31 08:23:28 2010
+++ /trunk/scm/process.scm Mon Aug 2 22:24:42 2010
@@ -29,6 +29,7 @@
;;; SUCH DAMAGE.
;;;;
+(require-extension (srfi 2))
(require "i18n.scm")
(require "fileio.scm")
(require-dynlib "process")
@@ -42,6 +43,10 @@
(execve file argv envp)
(execvp file argv))))
+(define process-exec-failed 1)
+(define process-dup2-failed 2)
+(define process-fork-failed 4)
+
(define (process-io file . args)
(let-optionals* args ((argv (list file)))
(and-let* ((pin (create-pipe))
@@ -50,7 +55,8 @@
(pin-out (cdr pin))
(pout-in (car pout))
(pout-out (cdr pout)))
- (let ((pid (process-fork)))
+ (let ((pid (process-fork))
+ (ret 0))
(cond ((< pid 0)
(begin
(uim-notify-fatal (N_ "cannot fork"))
@@ -63,22 +69,37 @@
(setsid)
(file-close pin-out)
(if (< (duplicate-fileno pin-in 0) 0)
- (uim-notify-fatal (N_ "cannot duplicate stdin")))
+ (begin
+ (uim-notify-fatal (N_ "cannot duplicate stdin"))
+ (set! ret (bitwise-ior ret process-dup2-failed))))
(file-close pin-in)
(file-close pout-in)
(if (< (duplicate-fileno pout-out 1) 0)
- (uim-notify-fatal (N_ "cannot duplicate stdout")))
+ (begin
+ (uim-notify-fatal (N_ "cannot duplicate stdout"))
+ (set! ret (bitwise-ior ret process-dup2-failed))))
(file-close pout-out)
(if (= (process-execute file argv) -1)
(uim-notify-fatal (format (N_ "cannot execute ~a") file)))
+ (set! ret (bitwise-ior ret process-exec-failed))
+ (file-write-string 1 (number->string ret))
(_exit 1)
)
(else ;; parent
(file-close pin-in)
(file-close pout-out)
- (cons pout-in pin-out)))))))
+ (if (and-let*
+ (((file-ready? (list pout-in) 100))
+ (lst (file-read pout-in 1))
+ ((not (eof-object? lst)))
+ ((> (string->number (list->string lst)) 0))))
+ (begin
+ (file-close pout-in)
+ (file-close pin-out)
+ #f)
+ (cons pout-in pin-out))))))))
(define (process-with-daemon file . args)
(let-optionals* args ((argv (list file)))
