job.guile 2.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657
  1. ;; -*- mode: scheme; -*-
  2. (use-modules (ice-9 popen))
  3. (use-modules (rnrs io ports))
  4. ;; This cannot be let-bound within `job'.
  5. (define currency-file (string-append (getenv "HOME") "/.cache/currency.units"))
  6. (define* (system-to-string #:rest args)
  7. (let* ((port (apply open-pipe* OPEN_READ args))
  8. (str (get-string-all port)))
  9. (close-pipe port)
  10. str))
  11. (define (gpg-keyinfo)
  12. "Return GPG keyinfo as a list of list of strings.
  13. Typical output is:
  14. S KEYINFO ???????????????????????????????????????? D - - - P - - -
  15. S KEYINFO ???????????????????????????????????????? D - - 1 P - - -
  16. The \"1\" means the key is cached."
  17. (filter (lambda (info) (string= (car info) "S"))
  18. (map (lambda (s) (string-split s #\space))
  19. (string-split
  20. (system-to-string "gpg-connect-agent" "keyinfo --list" "/bye")
  21. #\newline))))
  22. (define (gpg-key-cached?)
  23. "Return #t if a key is cached in the GPG agent, #f otherwise."
  24. (let ((keyinfo (gpg-keyinfo)))
  25. (not (null? (filter (lambda (info) (string= (list-ref info 6) "1"))
  26. keyinfo)))))
  27. (job
  28. (lambda (current-time)
  29. (let* ((seconds-in-a-day (* 60 60 24))
  30. (currency-time (if (not (file-exists? currency-file))
  31. 0
  32. (stat:mtime (stat currency-file)))))
  33. (if (< currency-time (- current-time seconds-in-a-day))
  34. ;; Use next-minute to avoid overwhelming the system in case of failure.
  35. (next-minute)
  36. (next-hour-from (next-day) (list (tm:hour (localtime currency-time)))))))
  37. ;; A string is nicer than Scheme code for `mcron --schedule' output.
  38. ;; Otherwise we could return '(system* "units_cur" currency-file)
  39. ;; and use job's 3rd argument as a description.
  40. (string-append "units_cur " currency-file))
  41. (job '(next-hour (range 0 24 3)) "updatedb-local")
  42. ;; (job '(next-minute (range 0 60 15))
  43. ;; (lambda ()
  44. ;; (when (gpg-key-cached?)
  45. ;; ;; Email is sync'ed from a pre-new hook.
  46. ;; (system* "notmuch" "new")))
  47. ;; "mail")