crossfire/crossfire/manifest.rkt

#lang racket/base
;; crossfire: distributed brute force infrastructure
;;
;; Copyright (C) 2020 haskal
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program 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 Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(require racket/bool racket/contract racket/list racket/match racket/vector
         "pattern.rkt")

;; a manifest is a list of list with the following fields
;; - 'name (string): name of project
;; - 'arch (listof string): list of supported arch triples, or "any"
;; - 'resources (listof string): list of required resources
;; - 'smp (boolean): #t will start one instance per CPU, #f means only one instance per node
;; - 'mode (symbol): currently 'stdio or 'callback
;; - 'command (listof string): command to start the process. args will be appended
;; - 'iset (cons symbol (listof iset-element)): define custom integer set (union of elements)
;; - 'pattern (listof pattern-element): pattern to brute force with (concatenation of elements)
;;
;; iset-element: one of
;; - (list start end): integer range
;; - '?x: another integer set
;; - string: all characters in the string
;;
;; pattern-element: one of
;; - (list start end): integer range
;; - '?x: another integer set
;; - string: pattern string, with ?x in the string corresponding to the defined integer set
;;
;; some predefined integer sets are available

(define builtin-isets
  (hash '?l (string->integer-set "abcdefghijklmnopqrstuvwxyz")
        '?u (string->integer-set "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
        '?d (string->integer-set "0123456789")
        '?s (string->integer-set " !\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~")
        '?a (range->integer-set 32 126)
        '?b (range->integer-set 0 255)
        '?? (char->integer-set #\?)))
(provide builtin-isets)

;; manifest contracts and definition
(define (iset-sym? x)
  (let ([y (symbol->string x)])
    (and (> 0 (string-length y)) (char=? #\? (string-ref y 0)))))
(define isub/c (or/c (list/c integer? integer?) (and/c symbol? iset-sym?) string?))
(define manifest-def/c (listof (or/c
                                 (list/c 'name string?)
                                 (cons/c 'arch (listof string?))
                                 (cons/c 'resources (listof string?))
                                 (list/c 'smp boolean?)
                                 (list/c 'mode (or/c 'stdio 'callback))
                                 (cons/c 'command (listof string?))
                                 (cons/c 'iset (cons/c symbol? (listof isub/c)))
                                 (cons/c 'pattern (listof isub/c)))))

(struct manifest [data pattern psize] #:transparent)
(provide (contract-out
           [struct manifest ((data manifest-def/c)
                             (pattern (vectorof integer-set?))
                             (psize integer?))]))


;; this "parses" to the extent that is necessary to avoid unnecessary pattern computations
;; the original data is stored, along with a flattened integer-set vector for the pattern and size
;; field counting the pattern size
(define/contract (parse-manifest manifest-def)
  (-> manifest-def/c manifest?)
  (define isets
    (for/fold ([isets builtin-isets]) ([mf-el (in-list manifest-def)]
                                       #:when (symbol=? 'iset (first mf-el)))
      (hash-set
        isets (second mf-el)
        (for/fold ([iset (make-integer-set '())]) ([iset-el (in-list (cddr mf-el))])
          (integer-set-union
            iset (match iset-el
                   [(list start end) (range->integer-set start end)]
                   [(? symbol? sym) (hash-ref isets sym)]
                   [(? string? str) (string->integer-set str)]
                   [_ (error "unrecognized entry in iset" iset-el)]))))))
  (define manifest-pattern
    (let ([pattern-entry (assoc 'pattern manifest-def)])
      (when (false? pattern-entry) (error "manifest needs a pattern"))
      (rest pattern-entry)))

  (define (get-iset x)
    (hash-ref isets x (lambda () (error "no such iset defined" x))))

  (define (parse-string-pattern ptn)
    (for/vector ([x (in-list (regexp-match* #rx"\\??." ptn))])
      (if (= 1 (string-length x))
        (char->integer-set (string-ref x 0))
        (get-iset (string->symbol x)))))

  (define patterns
    (for/list ([x (in-list manifest-pattern)])
      (match x
        [(? string?) (parse-string-pattern x)]
        [(? symbol?) (vector (get-iset x))]
        [(list start end) (vector (range->integer-set start end))]
        [_ (error "unrecognized pattern element in manifest" x)])))

  (define pattern (apply vector-append patterns))
  (define psize (pattern-count pattern))
  (manifest manifest-def pattern psize))

;; get data from the manifest
(define/contract (manifest-data-ref mf key [fail-thunk #f])
  (->* (manifest? symbol?) (any/c) any)
  (or (rest (assoc key (manifest-data mf)))
      (and (procedure? fail-thunk) (fail-thunk))
      fail-thunk))

;; the struct contains the original data
(define serialize-manifest manifest-data)

(provide parse-manifest manifest-data-ref serialize-manifest)