Browse Source

pigz last archives, match in the unarchiver

master
eta 3 months ago
parent
commit
0521ec2f23
  1. 63
      trackernet.lisp

63
trackernet.lisp

@ -384,8 +384,8 @@
(defparameter *trackernet-scrape-interval* 2.5)
(defparameter *trackernet-kill-switch* nil)
(defparameter *prediction-expiry-secs* 60)
(defparameter *train-active-expiry-secs* 60)
(defparameter *train-set-code-expiry-secs* 120)
(defparameter *train-active-expiry-secs* 180)
(defparameter *train-set-code-expiry-secs* 360)
(defparameter *rude-requests-per-minute* 300)
(defun make-trackernet-filename (pred)
@ -566,6 +566,15 @@
(local-time:now)
:format '((:year 4) #\- (:month 2) #\- (:day 2))))
(defun get-iso-8601-date-yesterday ()
"Returns yesterday's date, in %Y-%m-%d format."
(local-time:format-timestring
nil
(let ((now (local-time:now)))
(setf (local-time:day-of now) (1- (local-time:day-of now)))
now)
:format '((:year 4) #\- (:month 2) #\- (:day 2))))
(defun make-fake-archive-entry (filename size)
"Make a fake tar header for a file with name FILENAME and size SIZE (bytes)."
(make-instance 'archive::tar-entry
@ -591,8 +600,34 @@
:if-exists :append)
(conspack-encode-to-archive ar name data)))
(defun maybe-pigz-last-archive ()
"Runs `pigz` blocking-ly on yesterday's tar archive, if it exists."
(let ((filename (format nil "~A~A.tar"
*trackernet-trains-archival-dir*
(get-iso-8601-date-yesterday))))
(when (probe-file filename)
(format t "~&archiver: pigz'ing ~A, please wait~%"
filename)
(let ((exit-code
(handler-case
(uiop:wait-process
(uiop:launch-program
`("pigz" "-11" ,filename)))
(error (e)
(format
*error-output*
"~&archiver: couldn't launch pigz: ~A~%"
e)))))
(if (and exit-code (zerop exit-code))
(format t "~&archiver: pigz'd last archive~%")
(format
*error-output*
"~&archiver: failed to pigz last archive: code ~A~%"
exit-code))))))
(defun archive-trains-tar (keys)
"Archive trains from KEYS, a list of Redis train sorted set keys."
(maybe-pigz-last-archive)
(archive:with-open-archive (tar
(format nil "~A~A.tar"
*trackernet-trains-archival-dir*
@ -623,15 +658,31 @@
(second train))
train)))))
(defun unarchive-trains-tar (path func)
(defun archive-entry-filename (entry)
(cond
((slot-boundp entry 'archive::pathname)
(namestring (archive::entry-pathname entry)))
(t (archive::name entry))))
(defun unarchive-trains-tar (path func &key match)
"Read trains from the archive at PATH, running FUNC on each decoded train object."
(ignore-errors ; The archive probably isn't going to be terminated
(archive:with-open-archive (tar path
:direction :input)
(archive:do-archive-entries (entry tar)
(let ((buf (flexi-streams:make-in-memory-output-stream)))
(archive::transfer-entry-data-to-stream tar entry buf)
(funcall func (cpk:decode (subseq (flexi-streams:get-output-stream-sequence buf) 0))))))))
(let ((buf (flexi-streams:make-in-memory-output-stream))
(filename (ignore-errors (archive-entry-filename entry))))
(when (or
(not match)
(cl-ppcre:scan match filename))
(archive::transfer-entry-data-to-stream tar entry buf)
(funcall
func
(cons
filename
(cpk:decode
(subseq
(flexi-streams:get-output-stream-sequence buf) 0))))))))))
(defun archive-trains (keys)
"Archive trains from KEYS, a list of Redis train sorted set keys."

Loading…
Cancel
Save