[cl-ppcre-devel] Problems with a regexp using CL-PPCRE 0.7.4
Kick Damien-DKICK1
DKICK1 at motorola.com
Tue Mar 9 17:48:29 UTC 2004
I have been using CMUCL to reimplement some functionality that one
would find in Don Libes' Expect
<http://groups.google.com/groups?hl=en&lr=&ie=UTF-8&oe=UTF-8&threadm=ovr7wx4l0x.fsf%40email.mot.com&rnum=3&prev=/groups%3Fq%3Ddamien%2Bkick%2Bexpect%2Blisp%26hl%3Den%26lr%3D%26ie%3DUTF-8%26oe%3DUTF-8%26selm%3Dovr7wx4l0x.fsf%2540email.mot.com%26rnum%3D3>,
using CL-PPCRE for the regular expression engine. Thank you all for
providing this excellent library to the CL community. I've especially
enjoyed being able to use a sexp notation for regexes. However, I
think I've found a regexp that breaks CL-PPCRE. Perhaps I've given
CL-PPCRE an ill formed regexp or corrupted the Lisp image with some
bad code? I've tried to par down the code that caused my original
problem, though I'm afraid it is not nearly as concise as it could be.
Please feel free to yell at me if I should spend more time trimming
the irrelevant code out of the example and I'll post a leaner version.
Using CL-PPCRE 0.7.4 "out of the box", I was seeing my CMUCL process
handling a SIGSEGV. Because of this, I recompiled the CL-PPCRE code
after removing all of the "(declare (optimize speed ...))" statements.
The following is an edited transcript (to remove machine address,
logins (urk! not a word), and passwords) of the results of using the
unoptimized CL-PPCRE (again, using the optimized CL-PPCRE was giving
me a SIGSEGV at the same point of error). Please let me know what you
think; i.e. is this a CL-PPCRE bug or have I done something wrong?
% cmucl
; Loading #p".../.cmucl-init.sparcf".
;; Loading #p".../src/clocc-20040206/clocc.sparcf".
;; Loading #p".../src/clocc-20040206/src/defsystem-3.x/defsystem.sparcf".
CMU Common Lisp 18e, running on gsdapp04
With core: .../sparc-sun-solaris2.6/lib/cmucl/lib/lisp.core
Dumped on: Tue, 2003-04-08 13:23:10-05:00 on achat
See <http://www.cons.org/cmucl/> for support information.
Loaded subsystems:
Python 1.1, target SPARCstation/Solaris 2
CLOS 18e (based on PCL September 16 92 PCL (f))
* (load "break-cl-ppcre")
; Loading #p".../lti/break-cl-ppcre.sparcf".
Type-error in COMMON-LISP::PACKAGE-OR-LOSE: "CL-PPCRE" is not of type PACKAGE
Restarts:
0: [CONTINUE] Make this package.
1: Return NIL from load of "break-cl-ppcre".
2: [ABORT ] Return to Top-Level.
Debug (type H for help)
(COMMON-LISP::PACKAGE-OR-LOSE "CL-PPCRE")
Source: Error finding source:
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM: Source file no longer exists:
target:code/package.lisp.
0] 0
T
* (load "cl-ppcre-0.7.4/load")
; Loading #p".../lti/cl-ppcre-0.7.4/load.lisp".
;; Loading #p".../lti/cl-ppcre-0.7.4/packages.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/specials.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/util.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/errors.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/lexer.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/parser.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/regex-class.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/convert.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/optimize.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/closures.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/repetition-closures.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/scanner.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/api.sparcf".
;; Loading #p".../lti/cl-ppcre-0.7.4/ppcre-tests.sparcf".
T
* (load "break-cl-ppcre")
; Loading #p".../lti/break-cl-ppcre.sparcf".
T
* (setf break-cl-ppcre::*test-expect-login* #| ... |#)
#| ... |#
* (setf break-cl-ppcre::*test-expect-password* #| ... |#)
#| ... |#
* (break-cl-ppcre::test-telnet #| ... |#)
Trying #| ... |#...
Connected to #| ... |#.
Escape character is '^]'.
SunOS 5.6
login: #| ... |#
Password:
Last login: Fri Mar 5 04:44:33 from 10.17.193.24
Sun Microsystems Inc. SunOS 5.6 Generic August 1997
tekelec:[/tekelec/users/#| ... |#] 1 % ls
SEdisplaylJ_1N_ log mgts_cit_csh
auto.sh mgts.Xdefaults mgts_cit_env
auto_datafiles.tar mgts.cshrc mgts_gsr6.tar
datafile.6.0.1.0.4.tar mgts.login mgts_run
datafiles mgts.profile mgts_umt_csh
datafiles.bak mgts.xinitrc set_mgts_env
install.errors mgts.xsession
tekelec:[/tekelec/users/#| ... |#] 2 %
T
* (break-cl-ppcre::test-telnet #| ... |#
:prompt break-cl-ppcre::+default-mgts-server-prompt--break-cl-ppcre+)
Trying #| ... |#...
Connected to #| ... |#.
Escape character is '^]'.
SunOS 5.6
login: #| ... |#
Type-error in KERNEL::OBJECT-NOT-TYPE-ERROR-HANDLER:
-1 is not of type (MOD 536870911)
Restarts:
0: [ABORT] Return to Top-Level.
Debug (type H for help)
("DEFUN CREATE-BMH-MATCHER" -2)
Source:
; File: .../lti/cl-ppcre-0.7.4/scanner.lisp
(BMH-MATCHER-AUX)
0] (debugger)
;
; Warning: This function is undefined:
; DEBUGGER
; Error in KERNEL:%COERCE-TO-FUNCTION: the function DEBUGGER is undefined.
Error flushed ...
0] (break)
Break
Restarts:
0: [CONTINUE] Return from BREAK.
1: [ABORT ] Return to debug level 1.
2: Return to Top-Level.
Debug (type H for help)
(DEBUG::DEBUG-EVAL-PRINT (BREAK))
Source: Error finding source:
Error in function DEBUG::GET-FILE-TOP-LEVEL-FORM: Source file no longer exists:
target:code/debug.lisp.
0]] backtrace
0: (DEBUG::DEBUG-EVAL-PRINT (BREAK))
1: (DEBUG::DEBUG-LOOP)
2: (DEBUG:INTERNAL-DEBUG)
3: (DEBUG::INVOKE-TTY-DEBUGGER #<TYPE-ERROR {4080E945}>)
4: (DEBUG::REAL-INVOKE-DEBUGGER #<TYPE-ERROR {4080E945}>)
5: (INVOKE-DEBUGGER #<TYPE-ERROR {4080E945}>)
6: (ERROR TYPE-ERROR :FUNCTION-NAME "DEFUN CREATE-BMH-MATCHER" :DATUM ...)
7: (KERNEL::OBJECT-NOT-TYPE-ERROR-HANDLER "DEFUN CREATE-BMH-MATCHER"
#.(SYSTEM:INT-SAP #x38000308)
#<Alien (* #) at #xFFBEDEC0>
(429 526))
8: (KERNEL::INTERNAL-ERROR #.(SYSTEM:INT-SAP #xFFBEDEC0) #<unused-arg>)
9: ("Foreign function call land")
10: ("DEFUN CREATE-BMH-MATCHER" -2)
11: ("DEFUN CREATE-SCANNER-AUX" " " 0 1)
12: ("DEFMETHOD EXPECT (FUNCTION STREAM)" #<unused-arg> #<unused-arg>
#<Closure Over Function "DEFUN CREATE-SCANNER-AUX" {4080DA81}>
#<Stream for descriptor 9> ...)
13: (BREAK-CL-PPCRE::TEST-TELNET #| ... |#
:LOGIN
NIL
:PASSWORD
...)
14: (INTERACTIVE-EVAL
(BREAK-CL-PPCRE::TEST-TELNET #| ... |#
:PROMPT
BREAK-CL-PPCRE::+DEFAULT-MGTS-SERVER-PROMPT--BREAK-CL-PPCRE+))
15: (COMMON-LISP::%TOP-LEVEL)
16: (COMMON-LISP::RESTART-LISP)
0]] (ext:quit)
Password:
% cat break-cl-ppcre.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 "login:")
(send (string-cat (string login) (string #\Newline)))
(expect "assword:")
(send (string-cat (string password) (string #\Newline)))
(expect prompt)
(send (string-cat "ls" (string #\Newline)))
(expect prompt)
t))
%
More information about the Cl-ppcre-devel
mailing list