Commit | Line | Data |
---|---|---|
4f839c09 TB |
1 | ;; Copyright (C) 2018 Thomas Balzer |
2 | ||
3 | ;; This file is part of tomd. | |
4 | ||
5 | ;; tomd is free software: you can redistribute it and/or modify | |
6 | ;; it under the terms of the GNU General Public License as published by | |
7 | ;; the Free Software Foundation, either version 3 of the License, or | |
8 | ;; (at your option) any later version. | |
9 | ||
10 | ;; tomd is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | ;; GNU General Public License for more details. | |
14 | ||
15 | ;; You should have received a copy of the GNU General Public License | |
16 | ;; along with tomd. If not, see <http://www.gnu.org/licenses/>. | |
17 | ||
efa4a8bd TB |
18 | |
19 | ;;; Commentary: | |
20 | ;;; job.scm is the guile definition of the job configuration | |
21 | ;;; interface that tomd will load on start. The goal of this is to | |
22 | ;;; allow for the kernel of the system management to run efficient c | |
23 | ;;; code, while the user facing configuration is in extensible and | |
24 | ;;; easy to use guile. | |
25 | ||
26 | ;;; Implemented options: | |
27 | ;;; :: job-list - the list of jobs that tomd processes on | |
28 | ;;; launch. the jobs that are found will started in | |
29 | ;;; order, taking into account the different options | |
30 | ;;; enabled in their initializers. the processing code | |
31 | ;;; runs an embedded guile parser, which in theory | |
32 | ;;; allows for the fields to be extended, so long as | |
33 | ;;; they evaluate to their intended types. errors in | |
34 | ;;; parsing of one job currently will crash the | |
35 | ;;; parsing of following jobs, with the error messages | |
36 | ;;; being output coming straight from guile. when an | |
37 | ;;; error handler is eventually added this problem | |
38 | ;;; should vanish. | |
39 | ;;; :: create-job - the constructor for a new job definition. each | |
40 | ;;; option allowed in this constructor has fall backs | |
41 | ;;; so that not all options are mandatory. | |
42 | ;;; #:command-line "" - mandatory field that specifies how to launch | |
43 | ;;; a job. | |
44 | ;;; #:args (list "") - optional field that allows for a list of | |
45 | ;;; arguments to be passed on the command-line. | |
46 | ;;; #:redirect #f - optional field that is a boolean to redirect | |
47 | ;;; stdout and stderr to a file in | |
48 | ;;; /var/log/tomd/#:name | |
49 | ;;; #:name "default" - name of the task for use in tomc, log files, | |
50 | ;;; etc. defaults to "default" | |
51 | ;;; #:start-trigger - under work, when tomd should run the | |
52 | ;;; job. can be any of 'login 'logout 'hourly | |
53 | ;;; 'boot 'shutdown | |
54 | ;;; #:end-trigger - under work, when tomd should run the | |
55 | ;;; job. can be any of 'login 'logout 'hourly | |
56 | ;;; 'boot 'shutdown | |
57 | ||
4f839c09 TB |
58 | (define-module (tomd job) |
59 | #:use-module (srfi srfi-9) | |
60 | #:export (create-job make-job | |
8c4961ec TB |
61 | job-command-line c-job-cmd |
62 | job-args c-job-args | |
63 | job-start-trigger c-job-start-trigger | |
64 | job-end-trigger c-job-end-trigger | |
06570394 | 65 | job-name c-job-name |
11e636da | 66 | job-redirect c-job-redirect |
8c4961ec | 67 | c-check-job)) |
4f839c09 TB |
68 | |
69 | ;;; records | |
70 | (define-record-type <job> | |
11e636da | 71 | (make-job name command-line args start-trigger end-trigger redirect) |
4f839c09 | 72 | job? |
06570394 | 73 | (name job-name) |
4f839c09 TB |
74 | (command-line job-command-line) |
75 | (args job-args) | |
76 | (start-trigger job-start-trigger) | |
11e636da TB |
77 | (end-trigger job-end-trigger) |
78 | (redirect job-redirect)) | |
4f839c09 | 79 | |
8c4961ec TB |
80 | ;;; this sillyness is because i'm not sure how to expand macros in scm_call |
81 | (define (c-check-job obj) | |
82 | (job? obj)) | |
83 | ||
84 | (define (c-job-cmd obj) | |
85 | (job-command-line obj)) | |
86 | ||
87 | (define (c-job-args obj) | |
88 | (job-args obj)) | |
89 | ||
90 | (define (c-job-start-trigger obj) | |
91 | (job-start-trigger obj)) | |
92 | ||
93 | (define (c-job-end-trigger obj) | |
94 | (job-end-trigger obj)) | |
95 | ||
06570394 TB |
96 | (define (c-job-name obj) |
97 | (job-name obj)) | |
98 | ||
11e636da TB |
99 | (define (c-job-redirect obj) |
100 | (job-redirect obj)) | |
101 | ||
4f839c09 TB |
102 | ;;; functions |
103 | (define (get-keyword-value args keyword default) | |
104 | (let ((keyword-value (memq keyword args))) | |
105 | (if (and keyword-value (>= (length keyword-value) 2)) | |
106 | (cadr keyword-value) | |
107 | default))) | |
108 | ||
109 | (define (create-job . rest) | |
110 | (let ((command-line (get-keyword-value rest #:command-line #f)) | |
111 | (args (get-keyword-value rest #:args (list))) | |
112 | (start-trigger (get-keyword-value rest #:start-trigger 'login)) | |
06570394 | 113 | (end-trigger (get-keyword-value rest #:end-trigger #f)) |
11e636da TB |
114 | (name (get-keyword-value rest #:name "default")) |
115 | (redirect (get-keyword-value rest #:redirect #f))) | |
4f839c09 | 116 | ;; do thing with keyword-ed variables |
8c4961ec TB |
117 | ;; (display "settings:") (newline) |
118 | ;; (format (current-output-port) | |
119 | ;; "command-line:~a" command-line) | |
120 | ;; (newline) | |
121 | ;; (format (current-output-port) | |
122 | ;; "args:~a" args) | |
123 | ;; (newline) | |
124 | ;; (format (current-output-port) | |
125 | ;; "start-trigger:~a" start-trigger) | |
126 | ;; (newline) | |
127 | ;; (format (current-output-port) | |
128 | ;; "end-trigger:~a" end-trigger) | |
129 | ;; (newline) | |
4f839c09 TB |
130 | |
131 | ;; create a new object that represents the args given. | |
06570394 TB |
132 | (make-job name |
133 | command-line | |
4f839c09 TB |
134 | args |
135 | start-trigger | |
11e636da TB |
136 | end-trigger |
137 | redirect) | |
4f839c09 | 138 | )) |