wip: create manifest.rkt
This commit is contained in:
parent
94e72e699d
commit
e9e315f001
|
|
@ -35,91 +35,3 @@
|
|||
[("-n" "--name") name "Who to say hello to" (set-box! who name)]
|
||||
#:args ()
|
||||
(void)))
|
||||
|
||||
|
||||
;; manifest.rkt processing
|
||||
|
||||
(define (parse-manifest manifest-def)
|
||||
(struct manifest [name arch resources smp mode command isets pattern] #:transparent)
|
||||
|
||||
(define-syntax (check-false stx)
|
||||
(syntax-case stx ()
|
||||
[(_ what)
|
||||
(with-syntax ([id (format-id stx "manifest-~a" #'what)]
|
||||
[idsym #''what])
|
||||
#'(when (false? (id mf))
|
||||
(error "manifest attribute missing:" idsym)))]))
|
||||
|
||||
(define mf
|
||||
(for/fold ([mf (manifest #f '("any") '() #f 'stdio #f builtin-isets #f)])
|
||||
([line (in-list manifest-def)])
|
||||
(match line
|
||||
[(list 'name name) (struct-copy manifest mf [name name])]
|
||||
[(list 'arch arch ...) (struct-copy manifest mf [arch arch])]
|
||||
[(list 'resources resources ...) (struct-copy manifest mf [resources resources])]
|
||||
[(list 'smp smp) (struct-copy manifest mf [smp smp])]
|
||||
[(list 'mode mode) (struct-copy manifest mf [mode mode])]
|
||||
[(list 'command command) (struct-copy manifest mf [command command])]
|
||||
[(list 'iset name val)
|
||||
(struct-copy manifest mf
|
||||
[isets (hash-set (manifest-isets mf)
|
||||
(symbol->string name) (string->integer-set val))])]
|
||||
[(list 'pattern pattern ...) (struct-copy manifest mf [pattern pattern])])))
|
||||
|
||||
(check-false name)
|
||||
(check-false command)
|
||||
(check-false pattern)
|
||||
|
||||
(define isets (manifest-isets mf))
|
||||
(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 x))))
|
||||
|
||||
(define patterns
|
||||
(for/list ([x (in-list (manifest-pattern mf))])
|
||||
(match x
|
||||
[(? string?) (parse-string-pattern x)]
|
||||
[(? symbol?) (vector (get-iset (symbol->string x)))]
|
||||
[(list start end) (vector (range->integer-set start end))]
|
||||
[_ (error "unrecognized pattern element in manifest" x)])))
|
||||
|
||||
(values (manifest-name mf) (manifest-arch mf) (manifest-resources mf) (manifest-smp mf)
|
||||
(manifest-mode mf) (manifest-command mf) (apply vector-append patterns)))
|
||||
|
||||
|
||||
;; test code
|
||||
|
||||
(define-values [name arch resources smp mode command pattern]
|
||||
(parse-manifest
|
||||
'((name "test")
|
||||
;; supported arch triples, or "any"
|
||||
(arch "aarch64-unknown-linux-gnu" "aarch64-linux-gnu")
|
||||
;; required resources
|
||||
(resources "hifive-board" "cuda")
|
||||
;; #t means crossfire will start one instance per CPU
|
||||
;; #f means only one instance per node
|
||||
(smp #f)
|
||||
;; stdio or callback
|
||||
(mode stdio)
|
||||
;; command to start the brute force process
|
||||
(command ("meme"))
|
||||
;; a helper integer set
|
||||
(iset ?m "0123456789")
|
||||
;; brute force pattern
|
||||
(pattern ?m "_?d"))))
|
||||
|
||||
(pattern-codegen pattern mode)
|
||||
;; inclusive range
|
||||
(define start (resolve-pattern-pos pattern (pos->pattern-pos pattern 10)))
|
||||
(define end (resolve-pattern-pos pattern (pos->pattern-pos pattern 21)))
|
||||
(printf "// args: ")
|
||||
(for ([s (in-vector start)] [e (in-vector end)])
|
||||
(apply printf "~a ~a ~a ~a "
|
||||
(map (lambda (x) (number->string x 16)) (list (car s) (cdr s) (car e) (cdr e)))))
|
||||
(printf "\n")
|
||||
(printf "// total: ~a\n" (pattern-count pattern))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,120 @@
|
|||
#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/match
|
||||
"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)))
|
||||
|
||||
|
||||
; (define (parse-manifest manifest-def)
|
||||
; (struct manifest [name arch resources smp mode command isets pattern] #:transparent)
|
||||
;
|
||||
; (define-syntax (check-false stx)
|
||||
; (syntax-case stx ()
|
||||
; [(_ what)
|
||||
; (with-syntax ([id (format-id stx "manifest-~a" #'what)]
|
||||
; [idsym #''what])
|
||||
; #'(when (false? (id mf))
|
||||
; (error "manifest attribute missing:" idsym)))]))
|
||||
;
|
||||
; (define mf
|
||||
; (for/fold ([mf (manifest #f '("any") '() #f 'stdio #f builtin-isets #f)])
|
||||
; ([line (in-list manifest-def)])
|
||||
; (match line
|
||||
; [(list 'name name) (struct-copy manifest mf [name name])]
|
||||
; [(list 'arch arch ...) (struct-copy manifest mf [arch arch])]
|
||||
; [(list 'resources resources ...) (struct-copy manifest mf [resources resources])]
|
||||
; [(list 'smp smp) (struct-copy manifest mf [smp smp])]
|
||||
; [(list 'mode mode) (struct-copy manifest mf [mode mode])]
|
||||
; [(list 'command command) (struct-copy manifest mf [command command])]
|
||||
; [(list 'iset name val)
|
||||
; (struct-copy manifest mf
|
||||
; [isets (hash-set (manifest-isets mf) name (string->integer-set val))])]
|
||||
; [(list 'pattern pattern ...) (struct-copy manifest mf [pattern pattern])])))
|
||||
;
|
||||
; (check-false name)
|
||||
; (check-false command)
|
||||
; (check-false pattern)
|
||||
;
|
||||
; (define isets (manifest-isets mf))
|
||||
; (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 mf))])
|
||||
; (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)])))
|
||||
;
|
||||
; (values (manifest-name mf) (manifest-arch mf) (manifest-resources mf) (manifest-smp mf)
|
||||
; (manifest-mode mf) (manifest-command mf) (apply vector-append patterns)))
|
||||
|
||||
|
||||
|
||||
; ;; test code
|
||||
;
|
||||
; (define-values [name arch resources smp mode command pattern]
|
||||
; (parse-manifest
|
||||
;
|
||||
; (pattern-codegen pattern mode)
|
||||
; ;; inclusive range
|
||||
; (define start (resolve-pattern-pos pattern (pos->pattern-pos pattern 10)))
|
||||
; (define end (resolve-pattern-pos pattern (pos->pattern-pos pattern 21)))
|
||||
; (printf "// args: ")
|
||||
; (for ([s (in-vector start)] [e (in-vector end)])
|
||||
; (apply printf "~a ~a ~a ~a "
|
||||
; (map (lambda (x) (number->string x 16)) (list (car s) (cdr s) (car e) (cdr e)))))
|
||||
; (printf "\n")
|
||||
; (printf "// total: ~a\n" (pattern-count pattern))
|
||||
|
|
@ -25,7 +25,6 @@
|
|||
;; re-export renamed integer-set accessors
|
||||
make-integer-set integer-set-contents integer-set-count integer-set-union
|
||||
integer-set-intersect integer-set-subtract
|
||||
builtin-isets
|
||||
pattern-count pos->pattern-pos resolve-pattern-pos
|
||||
pattern-range-take)
|
||||
|
||||
|
|
@ -66,14 +65,6 @@
|
|||
(define (range->integer-set a b)
|
||||
(make-integer-set `((,a . ,b))))
|
||||
|
||||
(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)))
|
||||
|
||||
;; resolved pattern pos: vector of IsetPos (obtained with pos->integer-set-pos)
|
||||
;; unresolved pattern pos: vector of Nat [0, count of iset)
|
||||
;; resolved pattern pos cannot be manipulated, unresolved can
|
||||
|
|
|
|||
Loading…
Reference in New Issue