(in-package :cl-user) (defpackage #:timeliner.locations (:use :cl #:timeliner.utils :cl-mongo) (:export #:import-location-events #:takedown-import #:find-location-at #:point->doc #:on-cron)) (in-package #:timeliner.locations) (defun reverse-geocode (lat lon) (let* ((data (yason:parse (flexi-streams:octets-to-string (drakma:http-request (format nil "http://open.mapquestapi.com/nominatim/v1/reverse.php?format=json&lat=~A&lon=~A" lat lon))))) (address (gethash "address" data))) (values (gethash "display_name" data) address))) (defmethod cl-mongo::bson-encode((key string) (value local-time:timestamp) &key (array nil)) (cl-mongo::bson-encode key (cl-mongo::make-bson-time (ts->ms value)) :array array)) (defun make-place-doc (loc) (let* ((point (cdr loc)) (lat (geo:latitude-deg point)) (lon (geo:longitude-deg point))) (multiple-value-bind (text address) (reverse-geocode lat lon) (kv (kv :ts (car loc)) (kv :type "place") (kv :title text) (kv :language (gethash "country_code" address)) (kv :loc (kv (kv :type "Point") ; GeoJSON Point (kv :coordinates (list lon lat)))))))) (defun save-places (places) (loop for place in places do (db.insert "events" (make-place-doc place)))) (defun extract-places (locs) (loop for loc in locs for point = (cdr loc) with last-place and last-loc and moved and need-add when last-loc do (setf moved (geo:distance>= (geo:distance-between point (cdr last-loc)) (geo:distance-meters 100))) when moved do (setf last-loc loc ; Store loc as possible place need-add t) when (and need-add last-place last-loc (geo:distance< (geo:distance-between (cdr last-place) (cdr last-loc)) (geo:distance-meters 200))) do (setf need-add nil) ; Do not add same place after glitch when (and need-add (> (local-time:timestamp-difference (car loc) (car last-loc)) 400)) ; When stayed in 100m for 6.6mins collect last-loc and do (setf need-add nil) (setf last-place last-loc) when (not last-loc) do (setf last-loc loc))) (defun doc->point (doc) (let ((coord (get-element "coordinates" (get-element "loc" doc)))) (geo:point-deg (second coord) (first coord)))) (defun doc->ts (doc) (local-time:unix-to-timestamp (floor (get-element "timestampMs" doc) 1000))) (defun docs->locs (docs) (loop for doc in docs collect (cons (doc->ts doc) (doc->point doc)))) (defun ts->kv (field ts) (let ((nd (local-time:timestamp+ ts 1 :day))) ($between field (* 1000 (local-time:timestamp-to-unix ts)) (* 1000 (local-time:timestamp-to-unix nd))))) (defun takedown-import (from-date) (let ((now (local-time:now))) (loop for ts = (local-time:parse-timestring from-date) then (local-time:timestamp+ ts 1 :day) for locs = (docs->locs (docs (db.sort "locations" (ts->kv "timestampMs" ts) :field "timestampMs" :limit 1500))) for places = (extract-places locs) when places do (format t "Inserting ~A places for ~A~%" (length places) ts) (save-places places) until (local-time:timestamp> ts now) finally (return ts)))) (defvar *google-cookie-jar*) (defvar *google-manual-header*) (defun load-history (from &optional (to (local-time:timestamp+ from 1 :day)) (trim nil)) (loop for loc in (cadadr (yason:parse (flexi-streams:octets-to-string (drakma:http-request "https://maps.google.com/locationhistory/b/0/apps/pvjson?t=0" :method :post :user-agent "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.114 Safari/537.36" :content (format nil "[null,~A,~A,~A]" (ts->ms from) (ts->ms to) (if trim "true" "false")) :cookie-jar *google-cookie-jar* :additional-headers (list (cons "x-manualheader" *google-manual-header*) '("referer" . "https://maps.google.com/locationhistory/b/0")))))) collect (cons (ms->ts (parse-integer (cadr loc))) (geo:point-deg (caddr loc) (cadddr loc))))) (defun get-history-xsrf-token () (let* ((page (drakma:http-request "https://maps.google.com/locationhistory/b/0/" :user-agent "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/35.0.1916.114 Safari/537.36" :cookie-jar *google-cookie-jar*)) (needle "window.LatitudeServerConstants['XsrfToken'] = '") (start (search needle page))) (when start (subseq page (+ start (length needle)) (position #\' page :start (+ start (length needle))))))) (defun point->doc (point) (when point (kv (kv :type "Point") ; GeoJSON Point (kv :coordinates (list (geo:longitude-deg point) (geo:latitude-deg point)))))) (defun make-location-doc (loc) (kv (kv "timestampMs" (ts->ms (car loc))) (kv "loc" (point->doc (cdr loc))))) (defun save-locations (locations) (loop for loc in locations do (db.insert "locations" (make-location-doc loc)))) (defun load-locations (from &optional (to (local-time:now))) (docs->locs (docs (db.sort "locations" ($between "timestampMs" (ts->ms from) (ts->ms to)) :field "timestampMs" :limit (floor (* 11/600 ; 1 loc per 60 sec + 10% (local-time:timestamp-difference to from))))))) (defun import-location-events (from &optional (to (local-time:timestamp+ from 1 :day))) (let* ((*google-cookie-jar* (load-chrome-cookie-jar ".google.com")) (*google-manual-header* (get-history-xsrf-token)) (locs (load-history from to nil))) (format t "Saving ~A locations for ~A~%" (length locs) from) (save-locations locs) (let* ((with-prev-locs (load-locations (local-time:timestamp- from 400 :sec) to)) (places (extract-places with-prev-locs))) (format t "Saving ~A place events~%" (length places)) (save-places places)))) (defun find-location-at (ms) (let* ((ts (ms->ts ms)) (docs (docs (db.sort "locations" ($between "timestampMs" (ts->ms (local-time:timestamp- ts 5 :minute)) (ts->ms (local-time:timestamp+ ts 5 :minute))) :field "timestampMs" :limit 15))) less greater) (loop for doc in docs for docMs = (get-element "timestampMs" doc) when (<= docMs ms) do (setf less doc) when (and (not greater) (> docMs ms)) do (setf greater doc)) (when (and less greater) (geo:interpolate-between-points (doc->point less) (doc->point greater) (/ (- ms (get-element "timestampMs" less)) (- (get-element "timestampMs" greater) (get-element "timestampMs" less))))))) (defun on-cron () (let* ((last-loc (first (docs (db.sort "locations" :all :field "timestampMs" :asc nil :limit 1)))) (from (or (and last-loc (doc->ts last-loc)) (local-time:timestamp- (today) 3 :day))) (to (local-time:timestamp-minimum (local-time:timestamp+ from 3 :day) (local-time:now)))) (import-location-events from to)))