blob: 9c1493a1ac9a1c384fabf05484ad449bc1eb39bf (
plain)
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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
(define-module (ryan-services file-manager)
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu services)
#:use-module (gnu services configuration)
#:use-module (gnu services shepherd)
#:use-module (gnu home services)
#:use-module (gnu home services shepherd)
#:use-module (srfi srfi-1)
#:use-module (guix gexp)
#:use-module (guix records)
#:export (downloads-garbage-collector-service-type
downloads-garbage-collector-configuration
downloads-garbage-collector-configuration?))
(define-configuration downloads-garbage-collector-configuration
(user
(string "")
"User to run under")
(no-serialization))
(define-public (home-symlinks files)
;; Simple service to symlink two paths. Treats all paths with HOME prepended
(for-each (lambda (pair)
(let ((path1 (car pair))
(path2 (cadr pair)))
(let ((full-path1 (string-append (getenv "HOME") "/" path1))
(full-path2 (string-append (getenv "HOME") "/" path2)))
(if (file-exists? full-path2)
(if (eq? (stat:type (lstat full-path2)) 'regular)
((display (format #f "WARNING: Deleting regular file ~a.\n" full-path2))
(delete-file full-path2)
(symlink full-path1 full-path2))
#f)
(symlink full-path1 full-path2)))))
files))
(define downloads-garbage-collector-service
(match-record-lambda <downloads-garbage-collector-configuration>
(user)
(let ((cleanup-command #~(list "find" (string-append "/home/" #$user "/Downloads") "-mtime" "+7" "-exec" "rm" "-rf" "'{}'" ";")))
(shepherd-service
(documentation "Garbage collect downloaded files more than 1 week old for USER.")
(provision '(downloads-garbage-collector))
;(requirement '(root))
(modules '((shepherd service timer)))
(start #~(make-timer-constructor
(calendar-event #:hours '(19) #:minutes '(50)
#:days-of-week '(monday))
(command #$cleanup-command)))
(stop #~(make-timer-destructor))
(actions (list (shepherd-action
(name 'trigger)
(documentation "Trigger GC in Downloads folder for USER")
(procedure #~(lambda _
(system (string-join #$cleanup-command " ")))))))))))
(define-public downloads-garbage-collector-service-type
(service-type
(name 'downloads-garbage-collector)
(description "Given a USER, clear files older than 1 week from Downloads folder")
(extensions
(list
(service-extension home-shepherd-service-type
(compose list downloads-garbage-collector-service))))
(default-value (downloads-garbage-collector-configuration))))
|
