[cl-ppcre-devel] Problems with a regexp using CL-PPCRE 0.7.4

Edi Weitz edi at agharta.de
Thu Mar 11 22:21:59 UTC 2004


So I've tried to reproduce the error you get and I didn't
succeed. I've temporarily enabled telnet on a local Linux machine and
set the bash PS1 prompt to be 'tekelec:[\w] \! % ' to be as close to
your example as possible. The whole transcript is below with only the
password removed. I had to change "Login" to "ogin" and "ls" to "ls
--color=never" but everything else is unchanged. CL-PPCRE is 0.7.4
compiled without modifications, CMUCL is 18e on a Linux (SuSE 9.0)
system.

Hmmm.....

Edi.




edi at bird:/tmp > cat expect.lisp
(defpackage #:break-cl-ppcre
  (:use #:common-lisp #:extensions #:cl-ppcre))

(in-package #:break-cl-ppcre)

;; I believe that the following regular expression is causing CL-PPCRE
;; to choke.
(defconstant +default-mgts-server-prompt--break-cl-ppcre+
  `(:sequence
    #\Newline
    "tekelec:["
    (:greedy-repetition 0 nil :everything)
    "] "
    (:greedy-repetition 1 nil :digit-class)
    " % "
    :end-anchor))

(defvar *test-expect-login* nil)
(defvar *test-expect-password* nil)

(declaim (inline string-cat))
(defun string-cat (&rest args)
  (apply #'concatenate 'string args))

(defmacro with-default-spawn ((default-spawn) &body code)
  `(flet ((expect (expected &optional (spawn ,default-spawn)
                            &key (echo *standard-output*))
           (expect expected spawn :echo echo))
          (send (message &optional (spawn ,default-spawn))
           (send message spawn)))
    (macrolet ((send1 (&rest message-parts)
                 `(send* ,',default-spawn , at message-parts)))
      , at code)))

(defmacro with-spawn-process ((id exec-name &optional exec-args
                               &key without-default-spawn)
                              &body code)
  (let ((exec-args-value (gensym "EXEC-ARGS-VALUE-")))
    `(let* ((,exec-args-value ,exec-args)
            (,id (spawn ,exec-name ,exec-args-value)))
      (unwind-protect
           ,(if without-default-spawn
                `(progn , at code)
                `(with-default-spawn (,id)
                  , at code))
        (process-close ,id)))))

(defmacro with-spawn-stream ((stream exec-name &optional exec-args
                              &key without-default-spawn)
                             &body code)
  (let ((exec-args-value (gensym "EXEC-ARGS-VALUE-"))
        (id (gensym "SPAWN-PROCESS-")))
    `(let ((,exec-args-value ,exec-args))
      (with-spawn-process (,id ,exec-name ,exec-args-value
                           :without-default-spawn t)
        (let ((,stream (process-pty ,id)))
          ,(if without-default-spawn
               `(progn , at code)
               `(with-default-spawn (,stream)
                 , at code)))))))

(defgeneric expect (expected spawn &key echo)
  (:documentation
"ARGS: EXPECTED SPAWN &KEY ECHO
This is a CMU CL version of Don Libes' expect.  EXPECTED is what one
expects to find on SPAWN, created by the function SPAWN."))

(defgeneric send (message spawn)
  (:documentation
"ARGS: MESSAGE SPAWN
A CMU CL version of Don Libe's send.  Send MESSAGE to SPAWN, created by
the function SPAWN."))

(defun send* (spawn &rest messages)
  (send (apply #'concatenate 'string (mapcar #'string messages))
        spawn))

(defun spawn (program &optional args)
"ARGS: PROGRAM &OPTIONAL ARGS
A CMU CL version of Don Libes' spawn.  PROGRAM is the name of the program
to be exec'd in a pseudo-terminal."
  (run-program program args :wait nil :pty t :input t :output t :error t))

(defmethod expect ((expected string) (spawn extensions::process)
                   &key (echo *standard-output*)
                        regexp
                        case-insensitive-mode
                        multi-line-mode
                        single-line-mode
                        extended-mode)
  (expect (create-scanner (if regexp
                              expected
                              (quote-meta-chars expected))
                          :case-insensitive-mode case-insensitive-mode
                          :multi-line-mode multi-line-mode
                          :single-line-mode single-line-mode
                          :extended-mode extended-mode)
          (process-pty spawn)
          :echo echo))

(defmethod expect ((expected string) (spawn stream)
                   &key (echo *standard-output*)
                        regexp
                        case-insensitive-mode
                        multi-line-mode
                        single-line-mode
                        extended-mode)
  (expect (create-scanner (if regexp
                              expected
                              (quote-meta-chars expected))
                          :case-insensitive-mode case-insensitive-mode
                          :multi-line-mode multi-line-mode
                          :single-line-mode single-line-mode
                          :extended-mode extended-mode)
          spawn
          :echo echo))

;; expected is a parse-tree
(defmethod expect ((expected t) (spawn extensions::process)
                   &key (echo *standard-output*)
                        case-insensitive-mode
                        multi-line-mode
                        single-line-mode
                        extended-mode
                        destructive)
  (expect (create-scanner expected
                          :case-insensitive-mode case-insensitive-mode
                          :multi-line-mode multi-line-mode
                          :single-line-mode single-line-mode
                          :extended-mode extended-mode
                          :destructive destructive)
          (process-pty spawn) :echo echo))

;; expected is a parse-tree
(defmethod expect ((expected t) (spawn stream)
                   &key (echo *standard-output*)
                        case-insensitive-mode
                        multi-line-mode
                        single-line-mode
                        extended-mode
                        destructive)
  (expect (create-scanner expected
                          :case-insensitive-mode case-insensitive-mode
                          :multi-line-mode multi-line-mode
                          :single-line-mode single-line-mode
                          :extended-mode extended-mode
                          :destructive destructive)
          spawn :echo echo))

;; expected is a scanner
(defmethod expect ((expected function) (spawn extensions::process)
                   &key (echo *standard-output*))
  (expect expected (process-pty spawn) :echo echo))

;; expected is a scanner
(defmethod expect ((expected function) (spawn stream)
                   &key (echo *standard-output*))
  (let ((buffer (make-array '(0) :element-type 'base-char
                            :fill-pointer 0 :adjustable t)))
    (with-output-to-string (match buffer)
      (let ((io (make-echo-stream spawn
                                  (if echo
                                      (make-broadcast-stream match echo)
                                      match))))
        ;; I know that this is going to be a horribly inefficient
        ;; algorithm; i.e. reading a single character at a time
        ;; and re-scanning the BUFFER every time a new character
        ;; is added.  I'll work on fixing this later.  For know, I
        ;; just want to get something working.  -- Damien Kick
        (loop
            (read-char io)
            (multiple-value-bind (match-start match-end reg-starts reg-ends)
                (scan expected buffer)
              (when match-start
                (return (values buffer match-start match-end
                                reg-starts reg-ends)))))))))

(defmethod send ((message string) (spawn extensions::process))
  (send message (process-pty spawn)))

(defmethod send ((message string) (spawn stream))
  (write-string message spawn)
  (force-output spawn)
  message)

(defun test-telnet
    (address
     &key (login *test-expect-login*)
          (password *test-expect-password*)
          (prompt '(:sequence
                    "tekelec:["
                    (:greedy-repetition 0 nil :everything)
                    #\]
                    (:greedy-repetition 1 nil #\Space)
                    (:greedy-repetition 1 nil (:char-class
                                               (:range #\0 #\9)))
                    (:greedy-repetition 1 nil #\Space)
                    #\%)))
  (with-spawn-stream (stream "telnet" (list address))
    (expect "ogin:")
    (send (string-cat (string login) (string #\Newline)))
    (expect "assword:")
    (send (string-cat (string password) (string #\Newline)))
    (expect prompt)
    (send (string-cat "ls --color=never" (string #\Newline)))
    (expect prompt)
    t))
edi at bird:/tmp > cmucl
; Loading #p"/home/edi/.cmucl-init".
; loading system definition from /usr/local/lisp/Registry/asdf-install.asd into
; #<The ASDF1015 package, 0/9 internal, 0/9 external>
; registering #<SYSTEM ASDF-INSTALL {48513F25}> as ASDF-INSTALL
CMU Common Lisp 18e, running on bird
With core: /usr/local/lib/cmucl/lib/lisp.core
Dumped on: Thu, 2003-04-03 15:47:12+02:00 on orion
See <http://www.cons.org/cmucl/> for support information.
Loaded subsystems:
    Python 1.1, target Intel x86
    CLOS 18e (based on PCL September 16 92 PCL (f))
* (mk:load-system :cl-ppcre)

; Loading #p"/usr/local/lisp/source/cl-ppcre/packages.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/specials.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/util.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/errors.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/lexer.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/parser.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/regex-class.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/convert.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/optimize.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/closures.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/repetition-closures.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/scanner.x86f".
; Loading #p"/usr/local/lisp/source/cl-ppcre/api.x86f".
(#<FILE: api> #<FILE: scanner> #<FILE: repetition-closures> #<FILE: closures>
 #<FILE: optimize> #<FILE: convert> #<FILE: regex-class> #<FILE: parser>
 #<FILE: lexer> #<FILE: errors> #<FILE: util> #<FILE: specials>
 #<FILE: packages>)
* (load (compile-file "expect.lisp"))

; Python version 1.1, VM version Intel x86 on 11 MAR 04 11:11:39 pm.
; Compiling: /tmp/expect.lisp 11 MAR 04 11:09:42 pm

; Byte Compiling Top-Level Form:
; Converted STRING-CAT.
; Compiling DEFUN STRING-CAT:
; Converted WITH-DEFAULT-SPAWN.
; Compiling DEFMACRO WITH-DEFAULT-SPAWN:
; Converted WITH-SPAWN-PROCESS.
; Compiling DEFMACRO WITH-SPAWN-PROCESS:
; Converted WITH-SPAWN-STREAM.
; Compiling DEFMACRO WITH-SPAWN-STREAM:
; Byte Compiling Top-Level Form:
; Converted SEND*.
; Compiling DEFUN SEND*:
; Converted SPAWN.
; Compiling DEFUN SPAWN:
; Compiling DEFMETHOD EXPECT (STRING EXTENSIONS::PROCESS):
; Compiling DEFMETHOD EXPECT (STRING STREAM):
; Compiling DEFMETHOD EXPECT (T EXTENSIONS::PROCESS):
; Byte Compiling Top-Level Form:
; Compiling DEFMETHOD EXPECT (T STREAM):
; Compiling DEFMETHOD EXPECT (FUNCTION EXTENSIONS::PROCESS):
; Compiling DEFMETHOD EXPECT (FUNCTION STREAM):
; Compiling DEFMETHOD SEND (STRING EXTENSIONS::PROCESS):
; Compiling DEFMETHOD SEND (STRING STREAM):
; Converted TEST-TELNET.
; Compiling DEFUN TEST-TELNET:
; Byte Compiling Top-Level Form:

; expect.x86f written.
; Compilation finished in 0:00:00.

T
* (in-package :break-cl-ppcre)

#<The BREAK-CL-PPCRE package, 44/44 internal, 0/2 external>
* (setf *test-expect-login* "edi")

"edi"
* (setf *test-expect-password* "********")

"********"
* (test-telnet "miles")
Trying 62.159.208.81...
Connected to miles.
Escape character is '^]'.
Welcome to SuSE Linux 7.1 (i386) - Kernel 2.4.0-4GB (5).

miles login: edi
Password:
Last login: Thu Mar 11 23:09:28 from trane.agharta.de
Have a lot of fun...
tekelec:[/tmp/foo] 501 % ls --color=never
08_zappa.mp3                genera-handbook.pdf
fpga-technology_charts.pdf  my-exchange-file-changed-functions.el
tekelec:[/tmp/foo] 502 %
T
* (test-telnet "miles" :prompt +default-mgts-server-prompt--break-cl-ppcre+)
Trying 62.159.208.81...
Connected to miles.
Escape character is '^]'.
Welcome to SuSE Linux 7.1 (i386) - Kernel 2.4.0-4GB (5).

miles login: edi
Password:
Last login: Thu Mar 11 23:12:44 from trane.agharta.de
Have a lot of fun...
tekelec:[/tmp/foo] 501 % ls --color=never
08_zappa.mp3                genera-handbook.pdf
fpga-technology_charts.pdf  my-exchange-file-changed-functions.el
tekelec:[/tmp/foo] 501 %
T
* (quit)
edi at bird:/tmp >




More information about the Cl-ppcre-devel mailing list