guile/tomd/job.scm

   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
  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
  58 (define-module (tomd job)
  59   #:use-module (srfi srfi-9)
  60   #:export (create-job make-job
  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
  65             job-name c-job-name
  66             job-redirect c-job-redirect
  67             c-check-job))
  68
  69 ;;; records
  70 (define-record-type <job>
  71   (make-job name command-line args start-trigger end-trigger redirect)
  72   job?
  73   (name job-name)
  74   (command-line job-command-line)
  75   (args job-args)
  76   (start-trigger job-start-trigger)
  77   (end-trigger job-end-trigger)
  78   (redirect job-redirect))
  79
  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
  96 (define (c-job-name obj)
  97   (job-name obj))
  98
  99 (define (c-job-redirect obj)
 100   (job-redirect obj))
 101
 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))
 113         (end-trigger   (get-keyword-value rest #:end-trigger   #f))
 114         (name          (get-keyword-value rest #:name          "default"))
 115         (redirect      (get-keyword-value rest #:redirect      #f)))
 116     ;; do thing with keyword-ed variables
 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)
 130
 131     ;; create a new object that represents the args given.
 132     (make-job name
 133               command-line
 134               args
 135               start-trigger
 136               end-trigger
 137               redirect)
 138     ))