Commentary in job.scm that explains usage.

[tlb/tomd.git] / guile / tomd / job.scm

;; Copyright (C) 2018 Thomas Balzer

;; This file is part of tomd.

;; tomd 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.

;; tomd 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 the GNU General Public License
;; along with tomd.  If not, see <http://www.gnu.org/licenses/>.


;;; Commentary:
;;;  job.scm is the guile definition of the job configuration
;;;  interface that tomd will load on start. The goal of this is to
;;;  allow for the kernel of the system management to run efficient c
;;;  code, while the user facing configuration is in extensible and
;;;  easy to use guile.

;;; Implemented options:
;;;  :: job-list - the list of jobs that tomd processes on
;;;                launch. the jobs that are found will started in
;;;                order, taking into account the different options
;;;                enabled in their initializers. the processing code
;;;                runs an embedded guile parser, which in theory
;;;                allows for the fields to be extended, so long as
;;;                they evaluate to their intended types. errors in
;;;                parsing of one job currently will crash the
;;;                parsing of following jobs, with the error messages
;;;                being output coming straight from guile. when an
;;;                error handler is eventually added this problem
;;;                should vanish.
;;;  :: create-job - the constructor for a new job definition. each
;;;                option allowed in this constructor has fall backs
;;;                so that not all options are mandatory.
;;;   #:command-line "" - mandatory field that specifies how to launch
;;;                       a job.
;;;   #:args (list "")  - optional field that allows for a list of
;;;                       arguments to be passed on the command-line.
;;;   #:redirect #f     - optional field that is a boolean to redirect
;;;                       stdout and stderr to a file in
;;;                       /var/log/tomd/#:name
;;;   #:name "default"  - name of the task for use in tomc, log files,
;;;                       etc. defaults to "default"
;;;   #:start-trigger   - under work, when tomd should run the
;;;                       job. can be any of 'login 'logout 'hourly
;;;                       'boot 'shutdown
;;;   #:end-trigger     - under work, when tomd should run the
;;;                       job. can be any of 'login 'logout 'hourly
;;;                       'boot 'shutdown

(define-module (tomd job)
  #:use-module (srfi srfi-9)
  #:export (create-job make-job
            job-command-line c-job-cmd
            job-args c-job-args
            job-start-trigger c-job-start-trigger
            job-end-trigger c-job-end-trigger
            job-name c-job-name
            job-redirect c-job-redirect
            c-check-job))

;;; records
(define-record-type <job>
  (make-job name command-line args start-trigger end-trigger redirect)
  job?
  (name job-name)
  (command-line job-command-line)
  (args job-args)
  (start-trigger job-start-trigger)
  (end-trigger job-end-trigger)
  (redirect job-redirect))

;;; this sillyness is because i'm not sure how to expand macros in scm_call
(define (c-check-job obj)
  (job? obj))

(define (c-job-cmd obj)
  (job-command-line obj))

(define (c-job-args obj)
  (job-args obj))

(define (c-job-start-trigger obj)
  (job-start-trigger obj))

(define (c-job-end-trigger obj)
  (job-end-trigger obj))

(define (c-job-name obj)
  (job-name obj))

(define (c-job-redirect obj)
  (job-redirect obj))

;;; functions
(define (get-keyword-value args keyword default)
  (let ((keyword-value (memq keyword args)))
    (if (and keyword-value (>= (length keyword-value) 2))
        (cadr keyword-value)
        default)))

(define (create-job . rest)
  (let ((command-line  (get-keyword-value rest #:command-line  #f))
        (args          (get-keyword-value rest #:args          (list)))
        (start-trigger (get-keyword-value rest #:start-trigger 'login))
        (end-trigger   (get-keyword-value rest #:end-trigger   #f))
        (name          (get-keyword-value rest #:name          "default"))
        (redirect      (get-keyword-value rest #:redirect      #f)))
    ;; do thing with keyword-ed variables
    ;; (display "settings:") (newline)
    ;; (format (current-output-port)
    ;;         "command-line:~a" command-line)
    ;; (newline)
    ;; (format (current-output-port)
    ;;         "args:~a" args)
    ;; (newline)
    ;; (format (current-output-port)
    ;;         "start-trigger:~a" start-trigger)
    ;; (newline)
    ;; (format (current-output-port)
    ;;         "end-trigger:~a" end-trigger)
    ;; (newline)

    ;; create a new object that represents the args given.
    (make-job name
              command-line
              args
              start-trigger
              end-trigger
              redirect)
    ))