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

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 ,@message-parts))) ,@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 ,@code) `(with-default-spawn (,id) ,@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 ,@code) `(with-default-spawn (,stream) ,@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))

%