[noctool-cvs] CVS source

imattsson imattsson at common-lisp.net
Wed Oct 22 19:41:10 UTC 2008


Update of /project/noctool/cvsroot/source
In directory cl-net:/tmp/cvs-serv5967

Modified Files:
	utils.lisp 
Log Message:
IM

Added another global and two functions for CRC32 (needed for Nagios
interop, but these may well go in now). The CRC32 implementation has been
tseted for output on an empty string and on a test string found on the
webb, so no exhaustive testing has been done.

TODO: Maybe, at least. Call (initialize-crc32) from within (compute-crc32)
  or, even better, move the initialisation into the DEFVAR (though that
  may get ugly, I don't know).


--- /project/noctool/cvsroot/source/utils.lisp	2008/06/14 12:41:43	1.10
+++ /project/noctool/cvsroot/source/utils.lisp	2008/10/22 19:41:10	1.11
@@ -2,7 +2,7 @@
 
 (defvar *base64* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
 (defvar *random-file* nil)
-
+(defvar *crc32-table* nil)
 
 
 (defmacro with-pty (ptyspec &body body)
@@ -231,3 +231,27 @@
 
 (defun get-class (name)
   (find-class (find-symbol (string name) *noctool-package*)))
+
+(defun initialize-crc32 ()
+  (unless *crc32-table*
+    (let ((poly #xEDB88320))
+      (setf *crc32-table* (make-array 256
+				      :element-type '(unsigned-byte 32)
+				      :initial-element 0))
+      (loop for ix from 0 to 255
+	    do (loop with crc = ix
+		     for cnt from 8 downto 1
+		     do (setf crc (if (oddp crc)
+				      (logxor poly (ash crc -1))
+				      (ash crc -1)))
+		     finally (setf (aref *crc32-table* ix)
+				   crc))))))
+
+(defun compute-crc32 (octet-vector)
+  "Computes the CRC32 of an octet vector" 
+  (let ((crc #xFFFFFFFF))
+    (loop for octet across octet-vector
+	  for ix = (logand (logxor crc octet) #xFF)
+	  do (setf crc (logxor (ash crc -8)
+			       (aref *crc32-table* ix))))
+    (logxor crc #xFFFFFFFF)))





More information about the noctool-cvs mailing list