Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;;;; Registering machines for use on the farm.
(in-package :philip-jose)
(defparameter *start-time* nil)
(defun get-start-time ()
(or *start-time* (setf *start-time* (get-real-time))))
(defun read-time (time)
(date:parse-time time :patterns
'((date::year (date::date-divider) date::month (date::date-divider) date::day
(date::time-divider) date::hour (date::time-divider) (date::minute)
(date::time-divider) (date::secondp)))))
(defun decode-registry-log-line (x)
(destructuring-bind (op user machine time-string &rest rest) (split-sequence #\SPACE x)
(let ((time (- (read-time time-string) +unix-epoch+))
(hash (position "#" rest :test #'string-equal))
ips limit args)
(if hash
(setf ips (subseq rest 0 hash)
args (subseq rest (1+ hash))
limit (ignore-errors
(+ time
(* (parse-number:parse-positive-real-number x)
(* 24 60 60)))))
(setf ips rest))
(values op user machine time ips limit args))))
(defparameter *registered-hosts* nil)
(defun process-registry-log ()
(let ((*registered-hosts* (make-hash-table :test 'equal)))
(with-open-file (s *registry-path*)
(process-registry-log-stream s))
(mapcar #'car (sort (hash-table->alist *registered-hosts*) #'< :key #'cdr))))
(defun process-registry-log-stream (s)
(loop for x = (read-line s nil)
while x do
(multiple-value-bind (op user machine time ips limit args) (decode-registry-log-line x)
(declare (ignore user ips args))
(when (and (<= time (get-start-time))
(or (null limit)
(< (get-start-time) limit)))
(cond
((string= "register" op)
(setf (gethash machine *registered-hosts*) time))
((string= "unregister" op)
(remhash machine *registered-hosts*)))))))