[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