1  #!/usr/bin/env -S guile -e "main" -s
 2  !#
 3  
 4  ;; -*- geiser-scheme-implementation: guile -*-
 5  
 6  (import (srfi srfi-1)
 7          (srfi srfi-26)
 8          (rnrs bytevectors)
 9          (ice-9 format)
10          (ice-9 binary-ports))
11  
12  ;;; File reading block size
13  (define BLOCK-SIZE 1024)
14  
15  ;;; Make backup file
16  (define MAKE-BACKUP #t)
17  
18  ;;; Vectors matching
19  (define (bytevector-match va vb skew)
20    (let ((alen (bytevector-length va))
21          (blen (bytevector-length vb)))
22      (let match-rec ((pos 0))
23        (if (>= pos blen)
24            #t
25            (if (or (>= (+ pos skew) alen)
26                    (< (+ pos skew) 0)
27                    (not
28                     (eq? (bytevector-u8-ref va (+ pos skew))
29                          (bytevector-u8-ref vb pos))))
30                #f
31                (match-rec (+ pos 1)))))))
32  
33  ;;; Find pattern in bytevector
34  (define (bytevector-find v pattern)
35    (let find-rec ((pos 0))
36      (if (>= pos (bytevector-length v))
37          #f
38          (if (bytevector-match v pattern pos)
39              pos
40              (find-rec (+ pos 1))))))
41  
42  ;;; Find binary sequence in file
43  (define (find-binary-sequence port seq current-position)
44    (let ((seqlen (bytevector-length seq)))
45      (let find-rec ((pos current-position))
46        (let ((data (get-bytevector-n port BLOCK-SIZE)))
47          (if (eof-object? data)
48              #f
49              (let ((match (bytevector-find data seq)))
50                (if match
51                    (+ pos match)
52                    (if (< (bytevector-length data) BLOCK-SIZE)
53                        #f
54                        (begin
55                          (unget-bytevector port data (- BLOCK-SIZE seqlen) seqlen)
56                          (find-rec (- (+ pos BLOCK-SIZE) seqlen)))))))))))
57  
58  ;;; Patch binary file
59  (define* (patch-file! file pos seq #:key (backup #f))
60    (let ((port (open-file file "r+")))
61      (seek port pos SEEK_SET)
62      (when backup
63        (copy-file file (string-append file ".bak")))
64      (seek port pos SEEK_SET)
65      (put-bytevector port seq)
66      (close-port port)))
67  
68  ;;; Return byte n of the number x
69  (define (byte-ref x n)
70    (bit-extract x (* n 8) (* (+ 1 n) 8)))
71  
72  ;;; Convert number to bytes
73  (define (uint->bytevector uint)
74    (let ((bcount (ceiling (/ (integer-length uint) 8))))
75      (u8-list->bytevector
76       (map (lambda (n) (byte-ref uint n)) (reverse (iota bcount))))))
77  
78  ;;; MAIN
79  (define (main args)
80    (if (< (length args) 4)
81        (begin
82          (format (current-error-port) "Usage: ~a <find-id-code-hex> <replace-id-code-hex> <bitstream.bit>\n" (first args))
83          (format (current-error-port) "Example: ~a deadbeef defec8ed blink.bit\n" (first args)))
84  
85        (let ((find (uint->bytevector (string->number (list-ref args 1) 16)))
86              (replace (uint->bytevector (string->number (list-ref args 2) 16)))
87              (file (list-ref args 3)))
88  
89          (let ((pos (call-with-input-file file
90                       (cut find-binary-sequence <> find 0)
91                       #:binary #t)))
92            (if pos
93                (begin
94                  (format #t "Pattern is found at position ~a. Replace.\n" pos)
95                  (patch-file! file pos replace #:backup MAKE-BACKUP))
96                (format #t "Pattern is not found. Abort.\n"))))))