modules/ryan-services/file-manager.scm
012e58699d4183dc27e13d60bf9a85e974d45b07
· 3.1 KB · 66 lines
raw
| 1 | (define-module (ryan-services file-manager) |
| 2 | #:use-module (gnu packages) |
| 3 | #:use-module (gnu packages base) |
| 4 | #:use-module (gnu services) |
| 5 | #:use-module (gnu services configuration) |
| 6 | #:use-module (gnu services shepherd) |
| 7 | #:use-module (gnu home services) |
| 8 | #:use-module (gnu home services shepherd) |
| 9 | #:use-module (srfi srfi-1) |
| 10 | #:use-module (guix gexp) |
| 11 | #:use-module (guix records) |
| 12 | #:export (downloads-garbage-collector-service-type |
| 13 | downloads-garbage-collector-configuration |
| 14 | downloads-garbage-collector-configuration?)) |
| 15 | |
| 16 | (define-configuration downloads-garbage-collector-configuration |
| 17 | (user |
| 18 | (string "") |
| 19 | "User to run under") |
| 20 | (no-serialization)) |
| 21 | |
| 22 | (define-public (home-symlinks files) |
| 23 | ;; Simple service to symlink two paths. Treats all paths with HOME prepended |
| 24 | (for-each (lambda (pair) |
| 25 | (let ((path1 (car pair)) |
| 26 | (path2 (cadr pair))) |
| 27 | (let ((full-path1 (string-append (getenv "HOME") "/" path1)) |
| 28 | (full-path2 (string-append (getenv "HOME") "/" path2))) |
| 29 | (if (file-exists? full-path2) |
| 30 | (if (eq? (stat:type (lstat full-path2)) 'regular) |
| 31 | ((display (format #f "WARNING: Deleting regular file ~a.\n" full-path2)) |
| 32 | (delete-file full-path2) |
| 33 | (symlink full-path1 full-path2)) |
| 34 | #f) |
| 35 | (symlink full-path1 full-path2))))) |
| 36 | files)) |
| 37 | |
| 38 | (define downloads-garbage-collector-service |
| 39 | (match-record-lambda <downloads-garbage-collector-configuration> |
| 40 | (user) |
| 41 | (let ((cleanup-command #~(list "find" (string-append "/home/" #$user "/Downloads") "-mtime" "+7" "-exec" "rm" "-rf" "{}" "';'"))) |
| 42 | (shepherd-service |
| 43 | (documentation "Garbage collect downloaded files more than 1 week old for USER.") |
| 44 | (provision '(downloads-garbage-collector)) |
| 45 | ;(requirement '(root)) |
| 46 | (modules '((shepherd service timer))) |
| 47 | (start #~(make-timer-constructor |
| 48 | (calendar-event #:hours '(8) #:minutes '(20) |
| 49 | #:days-of-week '(tuesday)) |
| 50 | (command #$cleanup-command))) |
| 51 | (stop #~(make-timer-destructor)) |
| 52 | (actions (list (shepherd-action |
| 53 | (name 'trigger) |
| 54 | (documentation "Trigger GC in Downloads folder for USER") |
| 55 | (procedure #~(lambda _ |
| 56 | (system (string-join #$cleanup-command " "))))))))))) |
| 57 | |
| 58 | (define-public downloads-garbage-collector-service-type |
| 59 | (service-type |
| 60 | (name 'downloads-garbage-collector) |
| 61 | (description "Given a USER, clear files older than 1 week from Downloads folder") |
| 62 | (extensions |
| 63 | (list |
| 64 | (service-extension home-shepherd-service-type |
| 65 | (compose list downloads-garbage-collector-service)))) |
| 66 | (default-value (downloads-garbage-collector-configuration)))) |