liminix

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README | LICENSE

backfill.fnl (2903B)

      1 (local { : file-exists? } (require :anoia))
      2 (local tai64 (require :anoia.tai64))
      3 (local { : write &as ll } (require :lualinux))
      4 
      5 (local O_WRONLY 1)
      6 (local O_RDWR 2)
      7 (local O_CREAT 64)
      8 
      9 (fn send-string [fd str]
     10   (case (write fd str)
     11     n (if (> (# str) n) (send-string (string.sub str n)) true)
     12     (nil code) nil))
     13 
     14 (fn send-message [fd tai message]
     15   (let [ts (tai64.to-timestamp tai)]
     16     (send-string fd (.. ts  (string.sub message 26)))))
     17 
     18 (fn parse-timestamp [message]
     19   (let [{ : s : n } (tai64.from-timestamp message)]
     20     (+ (* s 1000000000) n)))
     21 
     22 (fn spit [filename body]
     23   (with-open [f (assert (io.open filename :w))]
     24     (f:write  body)))
     25 
     26 (fn write-timestamp [file ts]
     27   (spit file (string.format "%d" ts))
     28   ts)
     29 
     30 (fn slurp [filename]
     31   (with-open [f (assert (io.open filename :r))]
     32     (f:read "a")))
     33 
     34 ;; Any message which claims to have been generated before the
     35 ;; first public release of Linux is most likely instead generated
     36 ;; by a device that has no battery-backed clock and no
     37 ;; sync with NTP. Because the system clock starts at 1970-1-1
     38 ;; we treat this timestamp as an offset from the actual boot time
     39 
     40 (local earliest-plausible-timestamp
     41        (tai64.from-unix (os.time {:year 1991 :month 9 :day 17})))
     42 
     43 (fn read-boot-time []
     44   (let [uptime (with-open [f (io.open "/proc/uptime"  :r)] (f:read "n"))
     45         s (math.floor uptime)
     46         now (tai64.from-unix (os.time))]
     47     ;; we deduct an extra second to ensure there are no backfilled messages
     48     ;; sent with timestamps later than the earliest live message.
     49     {:s (- now.s s 1) :n 0 }))
     50 
     51 (fn maybe-offset [timestamp boot-time]
     52   (if (< timestamp.s earliest-plausible-timestamp.s)
     53       {:s (+ timestamp.s boot-time.s) :n timestamp.n}
     54       timestamp))
     55 
     56 (let [[fifo-name stampfile] arg
     57       boot-time (read-boot-time)
     58       fifo (ll.open fifo-name O_WRONLY 0)]
     59   (var backfill? true)
     60   (var next-ts
     61        (if (file-exists? stampfile)
     62            (tonumber (slurp stampfile))
     63            0))
     64 
     65   (each [l (: (io.input) :lines "L")]
     66     (case l
     67       "# LOG-SHIPPING-START\n"
     68       (set backfill? false)
     69       "# LOG-SHIPPING-STOP\n"
     70       (set backfill? true)
     71       message
     72       (let [tai  (tai64.from-timestamp message)
     73             message-ts (+ (* tai.s 1000000000) tai.n)]
     74         (when (> message-ts next-ts)
     75           (set next-ts (write-timestamp stampfile message-ts)))
     76         (when (>= message-ts next-ts)
     77           (if backfill?
     78               (let [actual-time (maybe-offset tai boot-time)]
     79                 (when (not (send-message fifo actual-time message))
     80                   ;; If the fifo write fails, it could be a glitch or it
     81                   ;; could be some kind of wider outage.  Give up,
     82                   ;; and rely on the supervisor to restart us when
     83                   ;; conditions are again auspicious
     84                   (io.stderr:write "write failed\n")
     85                   (os.exit 1)))))))))