Author: ehuelsmann
Date: Thu Apr 19 17:50:36 2007
New Revision: 183
Modified:
trunk/package.lisp
trunk/utility.lisp
Log:
No idea why I wrote this, but I think it's generally usefull: hostmask matching.
Modified: trunk/package.lisp
==============================================================================
--- trunk/package.lisp (original)
+++ trunk/package.lisp Thu Apr 19 17:50:36 2007
@@ -86,6 +86,7 @@
:remove-user
:self-message-p
:user-eq-me-p
+ :mask-matches-p
:pass
:nick
:user-
Modified: trunk/utility.lisp
==============================================================================
--- trunk/utility.lisp (original)
+++ trunk/utility.lisp Thu Apr 19 17:50:36 2007
@@ -473,3 +473,44 @@
(find-user connection (pop arguments))
(pop arguments)))) ops)))))))))))
+
+;;;
+;;; Hostmask matcher
+;;;
+
+(defun do-mask-match (mask hostname mask-consumed host-consumed)
+ (if (= (length mask) (1+ mask-consumed))
+ ;; we're out of mask to match, hopefully, we're out of hostname too
+ (= (length hostname) (1+ host-consumed))
+ (let ((mask-char (char mask (1+ mask-consumed))))
+ (cond
+ ((eq mask-char #\?)
+ ;; match any character, if there is one
+ (do-mask-match mask hostname (1+ mask-consumed) (1+ host-consumed)))
+ ((eq mask-char #\*)
+ ;; match any number of characters (including zero)
+ (do ((match (do-mask-match mask hostname
+ (incf mask-consumed)
+ host-consumed)
+ (do-mask-match mask hostname
+ mask-consumed
+ (incf host-consumed))))
+ ((or (= (length hostname) (1+ host-consumed))
+ match)
+ match)))
+ ((= (1+ host-consumed) (length hostname))
+ ;; we're out of hostname...
+ nil)
+ (t
+ ;; match other characters by exact matches
+ (when (eq mask-char (char hostname (1+ host-consumed)))
+ (do-mask-match mask hostname
+ (1+ mask-consumed) (1+ host-consumed))))))))
+
+ (defun mask-matches-p (mask hostname)
+ "Wildcard matching.
+
+Uses `*' to match any number of characters and `?' to match exactly any
+one character. The routine does not enforce hostmask matching patterns,
+but can be used for the purpose."
+ (do-mask-match mask hostname -1 -1))