[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