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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of thye GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services admin)
#:use-module (gnu packages admin)
#:use-module (gnu packages base)
#:use-module (gnu services)
#:use-module (gnu services mcron)
#:use-module (gnu services shepherd)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:export (%default-rotations
%rotated-files
rottlog-configuration
rottlog-configuration?
rottlog-service
rottlog-service-type
thermald-configuration
thermald-service-type))
;;; Commentary:
;;;
;;; Various administration services.
;;;
;;; Code:
\f
;;;
;;; Rotlog
;;;
;;; This service implements configuration of rottlog by writing
;;; /etc/rottlog/{rc,hourly|daily|weekly}. Example usage
;;;
;;; (mcron-service)
;;; (service rottlog-service-type (rottlog-configuration))
(define %rotated-files
;; Syslog files subject to rotation.
'("/var/log/messages" "/var/log/secure" "/var/log/maillog"))
(define (syslog-rotation-config files)
#~(string-append #$(string-join files ",")
" {
sharedscripts
postrotate
" #$coreutils "/bin/kill -HUP $(cat /var/run/syslog.pid) 2> /dev/null
endscript
}
"))
(define (simple-rotation-config files)
#~(string-append #$(string-join files ",") " {
sharedscripts
}
"))
(define %default-rotations
`(("weekly"
,(computed-file "rottlog.weekly"
#~(call-with-output-file #$output
(lambda (port)
(display #$(syslog-rotation-config %rotated-files)
port)
(display #$(simple-rotation-config
'("/var/log/shepherd.log"
"/var/log/guix-daemon.log"))
port)))))))
(define (default-jobs rottlog)
(list #~(job '(next-hour '(0)) ;midnight
(lambda ()
(system* #$(file-append rottlog "/sbin/rottlog"))))
#~(job '(next-hour '(12)) ;noon
(lambda ()
(system* #$(file-append rottlog "/sbin/rottlog"))))))
(define-record-type* <rottlog-configuration>
rottlog-configuration make-rottlog-configuration
rottlog-configuration?
(rottlog rottlog-rottlog ;package
(default rottlog))
(rc-file rottlog-rc-file ;file-like
(default (file-append rottlog "/etc/rc")))
(periodic-rotations rottlog-periodic-rotations ;list of (name file) tuples
(default %default-rotations))
(jobs rottlog-jobs ;list of <mcron-job>
(default #f)))
(define (rottlog-etc config)
`(("rottlog" ,(file-union "rottlog"
(cons `("rc" ,(rottlog-rc-file config))
(rottlog-periodic-rotations config))))))
(define (rottlog-jobs-or-default config)
(or (rottlog-jobs config)
(default-jobs (rottlog-rottlog config))))
(define rottlog-service-type
(service-type
(name 'rottlog)
(extensions (list (service-extension etc-service-type rottlog-etc)
(service-extension mcron-service-type
rottlog-jobs-or-default)
;; Add Rottlog to the global profile so users can access
;; the documentation.
(service-extension profile-service-type
(compose list rottlog-rottlog))))
(default-value (rottlog-configuration))))
\f
;;;
;;; thermald
;;;
;;; This service implements cpu scaling. Helps prevent overheating!
(define-record-type* <thermald-configuration>
thermald-configuration make-thermald-configuration
thermald-configuration?
(ignore-cpuid-check? thermald-ignore-cpuid-check?
(default #f)))
(define (thermald-shepherd-service config)
(list
(shepherd-service
(provision '(thermald))
(documentation "Run thermald cpu frequency scaling.")
(start #~(make-forkexec-constructor
'(#$(file-append thermald "/sbin/thermald")
"--no-daemon"
#$@(if (thermald-ignore-cpuid-check? config)
'("--ignore-cpuid-check")
'()))))
(stop #~(make-kill-destructor)))))
(define thermald-service-type
(service-type
(name 'thermald)
(extensions (list (service-extension shepherd-root-service-type
thermald-shepherd-service)))
(default-value (thermald-configuration))))
;;; admin.scm ends here
|