WIP, tracking down some bugs with IRC help

mailfilter-parse.lisp

@@ -106,7 +106,7 @@
 
 (defun parse-if-line (line hash)
   (if (test-for-if line)
-      (let* ((regex (get-regex line))
+      (let* ((regex (cl-ppcre:create-scanner (get-regex line)))
              (regex-hash (make-regex-hash regex)))
         (setf (gethash "patterns" hash) (append (gethash "patterns" hash) (list regex-hash)))
         regex-hash)))
@@ -126,24 +126,36 @@
       (loop-file-until s (lambda (x) (declare (ignore x)))  #'parse-line hash))
     hash))
 
-(defun message-match (message-string pattern)
-  (let ((scanner (cl-ppcre:create-scanner (gethash "regex" pattern) :multi-line-mode t)))
-    (funcall scanner message-string)))
+(defun message-match (message pattern)
+  (let* ((scanner (gethash "regex" pattern))
+         (sb-impl::*default-external-format* :latin-1)
+         (message-stream (mel:message-header-stream message))
+         (test))
+    (loop for line = (read-line message-stream nil 'eof) do
+      (with-open-file (*standard-output*
+                       "/tmp/debug_data"
+                       :direction :output
+                       :if-exists :supersede)
+        (princ line))
+      (or (eq line 'eof) (setf test (funcall scanner line)))
+          until (or (eq line 'eof) test))
+    (close message-stream)
+    pattern))
 
 (defun handle-command (command args message)
   (when (string= command "to")
-    (let ((new-folder (mel:make-maildir-folder (pathname (car args)))))
-      (mel:move-message message new-folder))))
+    (let* ((pathname (pathname (concatenate 'string (remove #\" (car args)) "/")))
+           (new-folder (mel:make-maildir-folder pathname))
+           (sb-impl::*default-external-format* :latin-1))
+      (mel:copy-message message new-folder))))
 
 (defun handle-message (message patterns)
-  (let* ((sb-impl::*default-external-format* :latin-1)
-         (message-string (mel:message-string message)))
-    (labels ((my-message-match (pattern) (message-match message-string pattern)))
-      (let ((result (find-if #'my-message-match patterns)))
-        (when result
-          (let ((command (gethash "command" result))
-                (args (gethash "args" result)))
-            (handle-command command args message)))))))
+  (labels ((my-message-match (pattern) (message-match message pattern)))
+    (let ((result (find-if #'my-message-match patterns)))
+      (when result
+        (let ((command (gethash "command" result))
+              (args (gethash "args" result)))
+          (handle-command command args message))))))
 
 (defun filter-maildir-folder (mailfilter &optional src-folder)
   (let* ((mailfilter-rules (read-mailfilter-file mailfilter))