Os.N

中村といいます。 ML でもお世話になってます。

• Scheme でのオブジェクトシステムにも興味があったので、こんなもの作ってみました。 お目よごしですが。(いわゆる Expect の原始版)。(2004/10/08 11:55:41 PDT)
  
• timeout に対応させてみました。(2004/10/13 07:14:49 PDT)
  その際の疑問など。よろしかったら、コメントをお願いします。
  • open-input-fd-port の際、 :buffering :none としとかないと、改行のない 入力では sys-select で timeout 発生。そういうもの？
  • module にすると、 単体では (define (main argv).. が実行されなくなったので、 (provide "expect") の下に、

    (select-module user)
    (use expect)
    

    をおいて、その下に (define (main argv) ...) を置いた。こうして問題ない？
  • generic function と 通常の function で名前が重なるとまずいかな、と 心配したけれど、杞憂でした。引数に応じて切り替わってくれる。
    逆に generic function と 通常の function の違いってなんなんでしょう。
• あとは、、、
  • timeout 時に、単に exit している。error を raise するべき。
    Gauche の例外の使い方等をぼちぼち。
  • spawn は独立させるより、<expect> の initialize 関数の方がすっきり？
  • log を保持していくように。
  • expect-exact を作って、autoexpect.scm 。

#!/usr/bin/env gosh

;; $Id: expect.scm,v 1.11 2004/10/13 00:09:14 naka Exp $

(define-module expect
  (use gauche.process)
  (use gauche.termios)
  (export <Expect> spawn send-line expect expect-eof su expect2)
  )

(select-module expect)

(define-class <Expect> ()
  ((pid :init-value -1)
   fd iport oport readfds
   (timeout :init-value 5000000.0 ;; nsec 
            :init-keyword :timeout)))

(define-method spawn ((obj <Expect>) str)
  (let* ((args (string-split str #[\s]))
         (cmd (car args)))
    (receive
     (pid fd) (sys-forkpty)
     (if (= pid 0)
         (sys-exec cmd args '((0 . 0) (1 . 1) (2 . 2))) ;; child
         (begin ;; parent
           (slot-set! obj 'pid     pid)
           (slot-set! obj 'fd      fd)
           (slot-set! obj 'iport   (open-input-fd-port  fd :buffering :none))
           (slot-set! obj 'oport   (open-output-fd-port fd :buffering :line))
           (slot-set! obj 'readfds (make <sys-fdset>))
           (sys-fdset-set! (ref obj 'readfds) fd #t)
           ))
     )))

(define-method send-line ((obj <Expect>) str)
  (format (ref obj 'oport) "~a\n" str))
  
(define-method timeout-check ((obj <Expect>) . timeout)
  (let ((fd (ref obj 'fd))
        (readfds (ref obj 'readfds))
        (timeout (if (null? timeout) (ref obj 'timeout) (car timeout))))
    (receive
     (nfd . dum) (sys-select readfds #f #f timeout)
     (not (zero? nfd))
     )
    ))

(define-method read-char ((obj <Expect>) . timeout)
  (let ((iport (ref obj 'iport))
        (timeout (if (null? timeout) (ref obj 'timeout) (car timeout))))
    (if (timeout-check obj timeout)
        (read-char iport)
        (begin
          (print "timeout error")
          (exit)))  ;;; !!!!!!
    ))

(define-method read-line ((obj <Expect>))
    (let loop ((c (read-char obj))
               (str ""))
      (if (or (eof-object? c) (char=? c #\newline))
          str
          (loop (read-char obj) #`",str,c")
          ))
    )

(define-method expect2 ((obj <Expect>) regstr . timeout)
  (let ((regobj (string->regexp regstr))
        (timeout (if (null? timeout) (ref obj 'timeout) (car timeout))))
    (let loop ((c (read-char obj timeout))
               (str ""))
      (if (eof-object? c)
          str
          (if (char=? c #\newline)
              (begin
                (print str)
                (loop (read-char obj timeout) ""))
              (let* ((str #`",str,c")
                     (pos (rxmatch-start (regobj str))))
                (if pos
                    str
                    (loop (read-char obj timeout) str)
                    )))
          ))
    ))

(define-method expect ((obj <Expect>) regstr . timeout)
  (let ((regobj (string->regexp regstr))
        (timeout (if (null? timeout) (ref obj 'timeout) (car timeout))))
    (let loop ((c (read-char obj timeout))
               (str ""))
      (if (eof-object? c)
          str
          (let* ((str #`",str,c")
                 (pos (rxmatch-start (regobj str))))
            (if pos
                (substring str 0 pos)
                (loop (read-char obj timeout) str)
                ))
          ))
    ))

(define-method expect-eof ((obj <Expect>))
    (let loop ((c (read-char obj))
               (str ""))
      (if (eof-object? c)
          str
          (loop (read-char obj) #`",str,c")
          ))
    )

(provide "expect")

;;;;;;;;;;;;;;;;;;;;
;;
;; to show usage
;;
(select-module user)
(use expect)

(define-method su ((obj <Expect>) password rprompt)
  (spawn obj "su -")
  (expect obj "assword")
  (send-line obj password)
  (expect obj rprompt)
  )

(define (ssh host passwd cmds . rest)
  (let ((obj (make <Expect>))
        (prmpt (if (null? rest) "\\$ " (car rest))))
    (spawn obj #`"slogin ,host")
    (let ((ans (expect2 obj "(assword|yes)" 5000000.0)))
      (display ans)
      (if (char=? #\s (string-ref ans (- (string-length ans) 1)))
          (begin
            (send-line obj "yes")
            (display (expect2 obj "assword" 5000000.0)))))
    (send-line obj passwd)
    (display (expect2 obj prmpt 5000000.0))

    (for-each
     (lambda (cmd)
       (send-line obj cmd)
       ;;(print "*** " cmd " ***")
       (display (expect2 obj prmpt 100000.0))
       )
     cmds)
    ))

(define (usage-example2)
  (let ((obj (make <Expect>)))
    (spawn obj "cat")
    (send-line obj "123456789")
    (print "*** " (expect2 obj "678") " ***")))

(define (main argv)
  (usage-example2)
  ;;(ssh hostname password '("ls" "pwd" "date" "logout") "\\$ ")
  0)