(in-package :cl-user) (defpackage #:timeliner.utils (:use :cl :cl-mongo :sqlite) (:export #:ts->ms #:ms->ts #:$between #:make-keyword #:starts-with #:aget #:doc->plist #:load-chrome-cookie-jar #:today)) (in-package :timeliner.utils) (defun ts->ms (ts) (+ (* 1000 (local-time:timestamp-to-unix ts)) (floor (local-time:nsec-of ts) 1000000))) (defun ms->ts (ms) (multiple-value-bind (unix msec) (floor ms 1000) (local-time:unix-to-timestamp unix :nsec (* msec 1000000)))) (defun today () (local-time:adjust-timestamp (local-time:now) (set :hour 0) (set :minute 0) (set :sec 0) (set :nsec 0))) (defgeneric $between (a from to) (:documentation "cl-mongo between query")) (defmethod $between (a from to) (kv ($>= a from) ($< a to))) (defmethod $between (a (from local-time:timestamp) (to local-time:timestamp)) ($between a (cl-mongo::make-bson-time (ts->ms from)) (cl-mongo::make-bson-time (ts->ms to)))) (defun make-keyword (name) (values (intern (string-upcase name) "KEYWORD"))) (defun starts-with (str with) (string= (subseq str 0 (min (length str) (length with))) with)) (defmacro aget (key alist) `(cdr (assoc ,key ,alist :test #'string=))) (defvar *decode-doc-to* :plist "Document object type") (defgeneric decode-element (element) (:documentation "Convert cl-mongo element to preferred type")) (defmethod decode-element (element) element) (defmethod decode-element ((element document)) (case *decode-doc-to* (:plist (doc->plist element)))) (defmethod decode-element ((element cl-mongo::bson-time)) (ms->ts (cl-mongo::raw element))) (defun doc->plist (doc) (let ((*decode-doc-to* :plist) result) (loop for key in (get-keys doc) do (setf (getf result (make-keyword key)) (decode-element (get-element key doc)))) result)) (defmethod yason:encode ((object document) &optional (stream *standard-output*)) (let ((hash (cl-mongo::elements object))) (unless (cl-mongo::_local object) (setf (gethash "_id" hash) (crypto:byte-array-to-hex-string (doc-id object)))) (yason:encode hash stream))) (defmethod yason:encode ((object cl-mongo::bson-time) &optional (stream *standard-output*)) (yason:encode (cl-mongo::raw object) stream)) ;; Google Chrome Cookies loading (defvar *chrome-cookie-password* (crypto:ascii-string-to-byte-array "peanuts") "Password for PBKDF2") (defvar *chrome-cookie-salt* (crypto:ascii-string-to-byte-array "saltysalt") "Salt for PBKDF2") (defvar *chrome-cookie-iterations* 1 "PBKDF2 iteration count") (defvar *chrome-cookie-key-length* 16 "PBKDF2 key length") (defun chrome-make-cookie-cipher () (crypto:make-cipher 'crypto:aes :mode 'crypto:cbc :key (crypto:derive-key (crypto:make-kdf 'crypto:pbkdf2 :digest 'crypto:sha1) *chrome-cookie-password* *chrome-cookie-salt* *chrome-cookie-iterations* *chrome-cookie-key-length*) :initialization-vector (crypto:ascii-string-to-byte-array " "))) (defvar *chrome-cookie-file* (merge-pathnames #P".config/google-chrome/Default/Cookies" (user-homedir-pathname))) (define-condition bad-encoding-error (simple-error) ()) (defun chrome-cookie-decode (value) (when (mismatch (subseq value 0 3) (mapcar #'char-code (coerce "v10" 'list))) (error 'bad-encoding-verion)) (crypto:decrypt-in-place (chrome-make-cookie-cipher) value :start 3) (coerce (mapcar #'code-char (subseq (coerce value 'list) 3 (- (length value) (elt value (1- (length value)))))) 'string)) (defun load-chrome-cookie-jar (domain) (sqlite:with-open-database (db *chrome-cookie-file*) (make-instance 'drakma:cookie-jar :cookies (loop for (name host-key value path expires secure-p http-only-p encrypted) in (sqlite::execute-to-list db (format nil "select name, host_key, value, path, expires_utc, secure, httponly, encrypted_value from cookies where host_key like '%~A%'" domain)) collect (make-instance 'drakma:cookie :name name :domain host-key :value (if (string= value "") (chrome-cookie-decode encrypted) value) :path path :expires (if (equal expires 0) nil (floor expires 1000)) :securep (equal secure-p 1) :http-only-p (equal http-only-p 1)))))) ;;; parenscript macros (defpsmacro ! (&rest method-calls) `(chain ,@method-calls))