eta
/
intertube
1
0
Fork 0
Code Issues Pull Requests Projects Releases Activity
Browse Source

tweak rescue / archival behaviour massively, add stale tags

master
eta 2 months ago
parent
a199e82ca5
commit
53434c458c
2 changed files with 133 additions and 59 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 121
      trackernet.lisp
  2. 71
      wobsite.lisp

121
trackernet.lisp
View File

@ -403,8 +403,9 @@
(defparameter *trackernet-scrape-interval* 2.5)
(defparameter *trackernet-kill-switch* nil)
(defparameter *prediction-expiry-secs* 60)
(defparameter *train-active-expiry-secs* 300)
(defparameter *train-active-expiry-secs* 60)
(defparameter *train-set-code-expiry-secs* 360)
(defparameter *track-code-expiry-secs* 10)
(defparameter *rude-requests-per-minute* 300)
(defun make-trackernet-filename (pred)
@ -426,21 +427,17 @@
(defun redis-train (universal-ts line-code code-station train)
(with-slots (train-id set-no trip-no lcid seconds-to track-code location-desc leading-car-no) train
(when (and (or lcid train-id) seconds-to track-code)
(let ((tid (or (if (and lcid (string= lcid "0"))
nil
lcid)
(if (and set-no (string= set-no "000"))
nil
(format nil "set~A-t~A" set-no trip-no))
(format nil "tid~A" train-id))))
(when (and train-id seconds-to track-code)
(let ((tid (format nil "tid~A" train-id)))
;; get a mapping of seconds to -> track code
(red:zadd (format nil "~A-secs-to-track-code"
code-station)
seconds-to
track-code)
;; get a mapping of track code -> description
(when location-desc
(when (and location-desc
;; this is highly annoying
(not (string= location-desc "At Platform")))
(red:set (format nil "~A-track-desc-~A"
line-code track-code)
location-desc))
@ -458,42 +455,45 @@
tid
cl-ansi-text:+reset-color-string+
train)
(statsd-inc "intertube.new")
;; make a rescuable thingy
(red:setex (format nil "~A-rescue-~A"
line-code tid)
*train-active-expiry-secs*
(* 5 *train-active-expiry-secs*)
track-code))
;; mark this train as active
(red:setex (format nil "~A-active-~A"
line-code tid)
*train-active-expiry-secs*
"yep")
(unless (or (not leading-car-no) (string= leading-car-no "0")
(uiop:string-prefix-p "set" tid))
;; check whether the train's leading car no was previously
;; used by a train with a different id
(let ((lcn-train-id
(red:get
(format nil "~A-lcn-~A"
line-code leading-car-no))))
(when (and lcn-train-id
(not (string= lcn-train-id
tid)))
;; if so, it might be the same train
(format
*error-output*
"scraper(~A): ~Aleading car no ~A changed~A: ~A -> ~A~%"
code-station
(cl-ansi-text:make-color-string :yellow :style :background)
leading-car-no
cl-ansi-text:+reset-color-string+
lcn-train-id
tid)
(statsd-inc "intertube.leading-car-no-change")))
;; reserve the leading car no
(red:setex (format nil "~A-lcn-~A"
line-code leading-car-no)
*train-set-code-expiry-secs*
;; check whether the train's track code was previously
;; used by a train with a different id
(let ((cc-train-id
(red:get
(format nil "~A-curcode-~A"
line-code track-code))))
(when (and cc-train-id
(not (string= cc-train-id
tid)))
;; if so, it might be the same train
(format
nil
"scraper(~A): ~Atrack code ~A double occupied~A: ~A (~A recs) -> ~A (~A recs)~%"
code-station
(cl-ansi-text:make-color-string :yellow :style :background)
track-code
cl-ansi-text:+reset-color-string+
cc-train-id
(length (redis-cpk-sorted-set-all (format nil "~A-train-~A"
line-code cc-train-id)))
tid
(length (redis-cpk-sorted-set-all (format nil "~A-train-~A"
line-code tid))))
(statsd-inc "intertube.curcode-change"))
;; reserve the track code
(red:setex (format nil "~A-curcode-~A"
line-code track-code)
*track-code-expiry-secs*
tid))
(unless (or (string= set-no "000")
(uiop:string-prefix-p "set" tid))
@ -508,7 +508,7 @@
tid)))
;; if so, it might be the same train
(format
*error-output*
nil
"scraper(~A): ~Aset code ~A (~A) changed~A: ~A -> ~A~%"
code-station
(cl-ansi-text:make-color-string :magenta :style :background)
@ -701,35 +701,36 @@
(third (car (last (car (last train))))))
(*print-right-margin* nil))
(format
t
"~&archiver: ~Aarchiving ~A (~A recs)~A: ~A~%"
(cl-ansi-text:make-color-string :red :style :background)
nil
"~&archiver: maybe archiving ~A (~A recs): ~A~%"
(second train)
(length (car (last train)))
cl-ansi-text:+reset-color-string+
last-data)
(block continue
(loop
with new-score
for (new-code distance code-path)
in (sort (find-rescuable-train-dijkstra (track-code last-data) (subseq (second train) 0 1)) #'< :key #'cadr)
do (setf new-score (or (redis-first-score new-code) 0))
do (format
t
nil
"~&archiver: could rescue with: ~a @ ~a: ~A steps, ~A secs~%"
new-code
distance
(length code-path)
(- (redis-first-score new-code)
(- new-score
(first train)))
unless (or
(< (- (redis-first-score new-code)
(< (- new-score
(first train))
0)
(string= new-code (second train))
(> distance *rescue-max-dist*))
do (format
t
"~&archiver: ~adoing rescue with~a: ~a @ ~a: ~{~a~^ -> ~}~%"
"~&archiver: ~arescuing ~A with~a: ~a @ ~a: ~{~a~^ -> ~}~%"
(cl-ansi-text:make-color-string :cyan :style :background)
(second train)
cl-ansi-text:+reset-color-string+
new-code
distance
@ -738,15 +739,30 @@
(red:incr (format nil "~A-code-rescues-~A"
(subseq (second train) 0 1)
(track-code last-data)))
(red:del (second train))
(return-from continue))
(when (> (first train) (- (get-universal-time)
(* 5 *train-active-expiry-secs*)))
(return-from continue))
(format
t
"~&archiver: ~Aarchiving ~A (~A recs)~A: ~A~%"
(cl-ansi-text:make-color-string :red :style :background)
(second train)
(length (car (last train)))
cl-ansi-text:+reset-color-string+
last-data)
(red:incr (format nil "~A-code-archives-~A"
(subseq (second train) 0 1)
(track-code last-data)))
(statsd-inc "intertube.archived")
(conspack-encode-to-archive tar
(format nil "~A-~A.trn"
(first train)
(second train))
train)))))))
train)
(red:del (second train))))))))
(defun archive-entry-filename (entry)
(cond
@ -941,17 +957,18 @@ Stop if *TRACKERNET-KILL-SWITCH* is set to T."
"Archive all trains that have expired."
(let ((trains (get-archivable-trains)))
(unless (null trains)
(format t "~&archiver: ~A archivable trains~%"
(length trains))
;; (format t "~&archiver: ~A archivable trains~%"
;; (length trains))
;; sort the trains earliest-to-latest,
;; so rescue chaining has a chance of working
(sort trains #'<
:key #'redis-last-score)
(statsd-gauge "intertube.maybe-archivable" (length trains))
(handler-case
(progn
(archive-trains-tar trains)
(statsd-counter "intertube.archived" (length trains))
(mapc #'red:del trains))
(archive-trains-tar trains))
;; (statsd-counter "intertube.archived" (length trains))
;; (mapc #'red:del trains))
(error (e)
(format *error-output* "~&archiver: failed: ~A~%" e))))))

71
wobsite.lisp
View File

@ -67,7 +67,31 @@
:class "govuk-footer__meta-item govuk-footer__meta-item--grow"
(:span
:class "govuk-footer__licence-description"
"This webpage may contain wiggly donkers.")))))))))
"Powered by "
(:a
:class "govuk-footer__link"
:href "https://tfl.gov.uk/info-for/open-data-users/"
"open data from Transport for London")
"; track layout information generated internally. "
"Site design using the "
(:a
:class "govuk-footer__link"
:href "https://github.com/alphagov/govuk-frontend"
"GOV.UK Design System")
", under the terms of the "
(:a
:class "govuk-footer__link"
:href "https://github.com/alphagov/govuk-frontend/blob/master/LICENSE.txt"
"MIT License")
". "
"Please don't scrape or re-use information provided here "
"without express consent. All rights reserved."
(:span
:style "float: right;"
(:a
:class "govuk-footer__link"
:href "https://theta.eu.org/"
"an eta project")))))))))))
(defmacro render (() &body body)
`(with-rendering-context
@ -263,6 +287,13 @@
:class "govuk-tag govuk-tag--yellow train-reporter"
(who:esc reporter))
(who:str " ")))
(when (and code
(< (trackernet::redis-last-score code)
(- (get-universal-time) 30)))
(who:htm
(:strong
:class "govuk-tag govuk-tag--red train-stale"
"Stale")))
(:strong
:class "govuk-tag govuk-tag--grey train-track-code"
(who:esc (trackernet::track-code train))))))))
@ -292,12 +323,17 @@
(start-ts (universal-time-hms (first (first train-data))))
(last-train-obj (third (car (last train-data))))
(last-track-code (trackernet::track-code last-train-obj))
(secs-old (- (get-universal-time) (trackernet::redis-last-score train)))
(viz-data (multiple-value-list (trusted-serialize (list last-track-code))))
(max-to-show (min train-data-len
(or limit *max-train-lines*)))
(lcids '())
(dests '())
(wtts '()))
(setf train-data
(sort train-data #'>
:key (lambda (trn)
(first trn))))
(loop
for (ts reporter train) in train-data
do (pushnew (trackernet::set-no train) wtts
@ -321,14 +357,35 @@
train))
(:h1
:class "govuk-heading-xl"
(who:fmt "Train to ~A"
(who:fmt "Train to ~A "
(or
(trackernet::destination-desc
last-train-obj)
"nowhere")))
(:p
:class "govuk-body-l"
"Showing "
(cond
((> secs-old 90)
(who:htm
(:strong
:class "govuk-tag govuk-tag--red"
(who:fmt "Very Stale"))))
((> secs-old 30)
(who:htm
(:strong
:class "govuk-tag govuk-tag--red"
(who:fmt "Stale"))))
((> secs-old 15)
(who:htm
(:strong
:class "govuk-tag govuk-tag--orange"
"Intermittent")))
(t
(who:htm
(:strong
:class "govuk-tag govuk-tag--turquoise"
"Active"))))
" Showing "
(:strong
(who:fmt "~A" max-to-show))
" of "
@ -357,7 +414,9 @@
(:p
:class "govuk-body"
(who:fmt "Leading car IDs: ~{~A~^, ~} &middot; WTT IDs: ~{~A~^, ~} &middot; Destinations: ~{~A~^, ~}"
lcids wtts dests))
(nreverse lcids)
(nreverse wtts)
(nreverse dests)))
(:table
:class "govuk-table"
(:thead
@ -384,9 +443,7 @@
:class "govuk-table__body"
(loop
with last = nil
for (ts reporter train) in (sort train-data #'>
:key (lambda (trn)
(first trn)))
for (ts reporter train) in train-data
for i from 0
unless (or
(equal last (trackernet::track-code train))

Write Preview
Loading…
Cancel
Save