git.fiddlerwoaroof.com
Raw Blame History
#+fw.dump
(eval-when (:compile-toplevel :load-toplevel :execute)
  (load "~/quicklisp/setup.lisp")
  (require :uiop))

#+fw.dump
(ql:quickload '(:net.didierverna.clon :bit-smasher
                :ironclad :lparallel :serapeum))

(defpackage :fwoar.bloomutil
  (:use :cl)
  (:export ))
(in-package :fwoar.bloomutil)

(defun byte-array-to-integer (arr)
  (loop for cur across arr
        for sum = cur then (+ (ash sum 8) cur)
        finally (return sum)))

(defun file->idx (filter hash fn)
  (mod (byte-array-to-integer (ironclad:digest-file hash fn))
       (length filter)))

(defun bloom-file (filter hashes fn)
  (loop for hash in hashes
        do (setf (aref filter (file->idx filter hash fn)) 1))
  filter)

(defun parse-filter (filter)
  (bitsmash:hex->bits filter))

(defun serialize (filter)
  (bitsmash:bits->hex filter))

(defun has-file (filter hashes file)
  (loop with matches = 0
        for hash in hashes
        for count from 1
        do
           (when (= (elt filter (file->idx filter hash file))
                    1)
             (incf matches))
        finally (return (= matches count))))

(defvar *synopsis*
  (net.didierverna.clon:defsynopsis (:postfix "FILTER FILES..." :make-default nil)
    (flag :short-name "h" :long-name "help")
    (flag :short-name "c" :long-name "check")
    (flag :long-name "coord")))

(defun main ()
  (let* ((context (net.didierverna.clon:make-context :synopsis *synopsis*))
         (net.didierverna.clon:*context* context)
         (lparallel:*kernel* (lparallel:make-kernel (serapeum:count-cpus)))
         (hashes '(:md5 :sha256)))
    (cond ((net.didierverna.clon:getopt :context context
                                        :long-name "help")
           (net.didierverna.clon:help))
          ((net.didierverna.clon:getopt :context context
                                        :long-name "check")
           (destructuring-bind (filter file)
               (net.didierverna.clon:remainder :context context)
             (if (has-file (parse-filter filter)
                           hashes
                           file)
                 (princ "true")
                 (princ "false")))
           (terpri))
          ((net.didierverna.clon:getopt :context context
                                        :long-name "coord")
           (destructuring-bind (filter . files)
               (net.didierverna.clon:remainder :context context)
             (loop for file in files
                   do (format t "(~{~4,' d~^ ~} ~a)~%"
                              (loop for hash in hashes
                                    collect (file->idx filter hash file))
                              file))
             (terpri)))
          (t
           (destructuring-bind (filter . files)
               (net.didierverna.clon:remainder :context context)
             (let ((bits (parse-filter filter)))
               (format t "~v,1,0,'0@a"
                       (length filter)
                       (serialize
                        (lparallel:preduce 'bit-ior
                                           (lparallel:pmap 'list
                                                           (lambda (file)
                                                             (bloom-file (copy-seq bits)
                                                                         hashes
                                                                         file))
                                                           files)
                                           :initial-value (copy-seq bits))))))
           (terpri)))))

(defun dump ()
  (setf net.didierverna.clon:*context* nil
        *features* (remove :fw.dump *features*))
  (net.didierverna.clon:dump "bloomutil" main))