2024-04-10 20:13:45 -04:00
|
|
|
(define-module (ryan-services file-manager)
|
|
|
|
|
#:use-module (gnu packages)
|
|
|
|
|
#:use-module (gnu packages base)
|
|
|
|
|
#:use-module (gnu services)
|
|
|
|
|
#:use-module (gnu services configuration)
|
2025-01-21 11:37:34 -05:00
|
|
|
#:use-module (gnu services shepherd)
|
2024-04-10 20:13:45 -04:00
|
|
|
#:use-module (gnu home services)
|
|
|
|
|
#:use-module (gnu home services shepherd)
|
|
|
|
|
#:use-module (srfi srfi-1)
|
2025-01-21 11:37:34 -05:00
|
|
|
#: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))
|
2024-04-10 20:13:45 -04:00
|
|
|
|
|
|
|
|
(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))
|
2025-01-21 11:37:34 -05:00
|
|
|
|
|
|
|
|
(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 '(8) #:minutes '(20)
|
|
|
|
|
#:days-of-week '(tuesday))
|
|
|
|
|
(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))))
|
