#!/bin/sh
: ; exec klone $0 "$@"
; The above line allows not to embed the exact path of the klone executable

;;Skeleton of a typical klone script

(setq args (getopts "USAGE: %0 [options] hexstring files...
grep-like program, but searches for string (in hxa) in files
Shows somes bytes of context around matches, ^ meaning start of file 
and $ end of file.
Can also patch files by setting strings at offsets, and be used as a minimal 
hex editor
Output is:
filename: hex_offset / dec_offset: left_context string right_context
"
    ("-li" () LI "string must be a decimal number that will be searched for in
files as a little endian (intel order) 4-byte number")
    ("-bi" () BI "string must be a decimal number that will be searched for in
files as a big endian (motorola order) 4-byte number")
    ("-a" () ASC "string is taken as ascii text")
    ("-e" () EVAL "ascii string is evaluated to expand klone string escapes: \\xXX
for char of ascii code XX in hexa, \\n, \\e, \\r, etc...")
    ("-c" N context "number of context bytes shown around matches. 
default to as much as fit in 80 columns")
    ("-p" () printables "shows also, underneath matches, the printable characters
Unprintable chars are show as undeline \"_\" characters")
    ("-s" N replace-at "do not search for string, instead sets the string at 
offset N in files, overwriting contents there.
N can be in decimal or hexa (prefixed by 0x)")
    ("-r" repstring replace-all "replace all occurences of string by repstring\n(hexadecimal string)") 
    ("-R" repstring replace-all-eval "replace all occurences of string by repstring\n(klone-evaluated ascii string)")
    ("-re" () REGEXP "hexstring is a regexp. Actually, not a true regexp, but a regexp\non the ascii representation: to match a number in brackets,\nsay 3c3[0-9]3e, <[0-9]> wont work\nThis work only to search, not to replace")
    ("-l" () LIST "string must be a number (decimal or 0x-prefixed hexa, only
lists memory at the location given by string")
    ("-m" N modulo "string must start at a multiple of N (4, 8...)")
    ("-q" () quiet "no output. Only return value can be used")
    ("-v" () verbose "verbose")
))

(if (not args) (getopts :usage))
(defvar found (list))
(setq context (if context (Int context) ()))
(if replace-all-eval (setq replace-all 
    (read (open (+ "\"" replace-all-eval "\"") :type :string)))
)
(if modulo (setq modulo (Int modulo)))

(defun main (&aux
  )
  (if LI (setq s (itole (Int (get args 0))))
    BI (setq s (itobe (Int (get args 0))))
    ASC (setq s (get args 0))
    EVAL (setq s (read (open (+ "\"" (get args 0) "\"") :type :string)))
    LIST (setq s (dec-or-hex (get args 0)))
    REGEXP (setq s (get args 0))
    t (setq s (decode-hex (get args 0)))
  )
  (if LIST (dolist (file (subseq args 1))
      (list-places s file))
  )
  (if replace-at (doreplace s replace-at (subseq args 1) t))
  (if replace-all (doreplace-all s (decode-hex replace-all) (subseq args 1)))
  (verbose? "Searching for %0" (encode-hex s))
  (dolist (file (subseq args 1))
    (if REGEXP
      (hexgrep-re s file (open file :error ()) (> (length args) 2) ())
      (hexgrep s file (open file :error ()) (> (length args) 2) ())
    )
  )
  (if (= 1 (length args))
    (if REGEXP
      (hexgrep-re s "stdin" *standard-input* () ())
      (hexgrep s "stdin" *standard-input* () ())
    )
  )
  (exit (if found 0 1))
)

(defun doreplace (s replace files must-exit? &aux offset fd)
  (setq offset (dec-or-hex replace))
  (verbose? "Setting %0 in files at offset %1" (encode-hex s) offset)
  (dolist (file files)
    (setq fd (open file :if-exists :overwrite :direction :io))
    (if (or (< offset 0) 
	(> (+ offset (length s)) (get (file-stats file) 'size)))
      (print-exit 1 "offset %1 is not inside file %0! aborting.\n" file offset)
    )
    (verbose? "Putting string %2 at offset %1 in file %0" file offset
      (encode-hex s)
    )
    (file-position fd offset)
    (write-chars s () fd)
    (close fd)
  )
  (if must-exit? (exit 0))
)

(defun doreplace-all (s replace files &aux (found found))
  (if (> (length replace) (length s))
    (print-exit 1 "Error: trying to replace a string %r0 by a longer one: %r1 !\n" s replace)
  )
  (verbose? "Replacing %0 by %1" (encode-hex s) (encode-hex replace))
  (dolist (file files)
    (setq found (list))
    (with (verbose () quiet t)
      (hexgrep s file (open file :error ()) () ())
    )
    (if found
      (with (fd (open file :if-exists :overwrite :direction :io))
	(dolist (pos found)
	  (verbose? "%0: %1 / %2: replacing %3 by %4"
	    file (itox pos) pos (encode-hex s) (encode-hex replace)
	  )
	  (file-position fd pos)
	  (write-chars replace () fd)
	)
	(close fd)
      )
    )
  )
  (exit 0)
)

(defun list-places (pos file &aux
    (s (make-string 24))
    (fd (open file :error ()))
    (context 0)
  )
  (hexgrep s file fd (> (length args) 2) pos) 
  (exit 0)
)

(defun hexgrep (s file fd show-filename? &optional one-pos &aux 
    buffer 
    (pos 0)
    hexpad decpad
    room-for-context
    (context context)
    (loop-cond (if one-pos
	'(if (= t one-pos) () (progn (setq pos one-pos) (setq one-pos t) pos))
	'(setq pos (seek buffer s pos))
    ))
  )
  (if (not fd) (progn
      (print-format *standard-error* "Error: cannot open file %0\n" file)
      (exit 1)
  ))
  (setq buffer (String fd))
  (setq hexpad (length (itox (length buffer))))
  (setq decpad (length (String (length buffer))))
  (setq room-for-context (/ (- 79 (+ (if show-filename? (+ (length file) 2) 0)
	  hexpad 3 decpad 2 2 (* 2 (length s)))) 4)
  )
  (setq context (if context context (max 0 room-for-context)))
  
  (while (eval loop-cond)
    (if (not (and modulo (/= 0 (mod pos modulo)))) (progn
	(lappend found pos)
	(if (not quiet) (progn
	    (if show-filename?
	      (print-format "%0: " file)
	    )
	    (print-format "%4%1 / %5%2: %3\n"
	      file (itox pos) pos (hexrep buffer pos s)
	      (make-string (- hexpad (length (itox pos))))
	      (make-string (- decpad (length (String pos))))
	    )
	    (if printables 
	      (print-format "%0%1\n"
		(make-string (+ 
		    (if show-filename? (+ (length file) 2) 0)
		    hexpad 3 decpad 2))
		(printable-rep (hexrep buffer pos s))
	    ))
	))
	(incf pos (length s))
      )
      (incf pos)
    )
  )
)

;; Same, but search on ascii encoding of file
(defun hexgrep-re (s file fd show-filename? &optional one-pos &aux 
    buffer 
    (pos 0)
    (ascpos 0)
    hexpad decpad
    room-for-context
    (context context)
    (re (regcomp s))
    len
  )
  (if (not fd) (progn
      (print-format *standard-error* "Error: cannot open file %0\n" file)
      (exit 1)
  ))
  (setq buffer (String fd))
  (setq ascbuffer (encode-hex buffer))
  (setq hexpad (length (itox (length buffer))))
  (setq decpad (length (String (length buffer))))
  (setq room-for-context (/ (- 79 (+ (if show-filename? (+ (length file) 2) 0)
	  hexpad 3 decpad 2 2 (length s))) 4)
  )
  (setq context (if context context (max 0 room-for-context)))
  
  (while (regexec re ascbuffer ascpos)
    (setq ascpos (0 (get re 0)))
    (if (/= 0 (mod ascpos 2)) (progn	;not on a byte start, ignore
	(incf ascpos)
      ) 
      (and modulo (/= 0 (mod (setq pos (/ascpos 2)) modulo)))
      (incf ascpos 2)

      (progn
	(setq pos (/ ascpos 2))
	(setq len (/ (- (1 (get re 0)) (0 (get re 0))) 2))
	(if (not quiet) (progn
	    (if show-filename?
	      (print-format "%0: " file)
	    )
	    (print-format "%4%1 / %5%2: %3\n"
	      file (itox pos) pos (hexrep buffer pos len)
	      (make-string (- hexpad (length (itox pos))))
	      (make-string (- decpad (length (String pos))))
	    )
	    (if printables 
	      (print-format "%0%1\n"
		(make-string (+ 
		    (if show-filename? (+ (length file) 2) 0)
		    hexpad 3 decpad 2))
		(printable-rep (hexrep buffer pos len))
	    ))
	))
	(setq ascpos (* 2 (/ (1 (get re 0)) 2)))	
      )
  ))
)

;; shows string and its context
(defun hexrep (buffer pos s &aux 
    (res (copy ""))
    (len (if (typep s Number) s (length s)))
  )
  (if (<= pos context)
    (nconc res "^")
  )
  (nconc res (encode-hex (subseq buffer (max 0 (- pos context)) pos)))
  (nconc res " ")
  (nconc res (encode-hex (subseq buffer pos (+ pos len))))
  (nconc res " ")
  (nconc res (encode-hex 
      (subseq buffer (+ pos len)
	(min (length buffer) (+ pos context len))
  )))
  (if (>= (+ pos context len) (length buffer))
    (nconc res "$")
  )
  res  
)

(defun printable-rep (s &aux 
    (res (copy "")) 
    upper-half-byte
    out
  )
  (dolist (c s)
    (setq out #\ )
    (if (seek encode-hex-values c)
      (if upper-half-byte
	(progn
	  (setq out (printable-rep-char 
	      (+ upper-half-byte (seek encode-hex-values c))))
	  (setq upper-half-byte ())
	)
	(setq upper-half-byte (* 16 (seek encode-hex-values c)))
    ))
    (put res -1 out)
  )
  res
)

(defun printable-rep-char (c)
  (if (and (>= c #\ ) (< c 127))
    c
    #\_
  )
)

(defun itole (n &aux (res (copy "")) (mul 1))
  (dotimes 4
    (put res -1 (logand 0xff n))
    (setq n (logshift n -8))
  )
  res
)

(defun itobe (n &aux (res (copy "")) (shift -24))
  (dotimes 4
    (put res -1 (logand 0xff (logshift n shift)))
    (incf shift 8)
  )
  res
)

;; decodes a number decimal or 0x_hex
(defun dec-or-hex (s)
  (if (match "^0x" s)
    (xtoi s)
    (Int s)
))

(defun decode-hex-error (s)
  (print-format "Error: string %0 is not hexadecimal!\n" s)
  (exit 1)
)

(setq decode-hex-values (Hashtable '(
      #\0 0 #\1 1 #\2 2 #\3 3 #\4 4 #\5 5 #\6 6 #\7 7 #\8 8 #\9 9
      #\a 10 #\b 11 #\c 12 #\d 13 #\e 14 #\f 15
      #\A 10 #\B 11 #\C 12 #\D 13 #\E 14 #\F 15
)))

(defun decode-hex (s &aux (i 0) (res (copy "")))
  (while (< i (length s))
    (if (= i (- (length s) 1))
      (decode-hex-error s)
    )
    (put res -1
      (+ (* 16 (get decode-hex-values (i s) '(decode-hex-error s)))
	(get decode-hex-values ((+ i 1) s) '(decode-hex-error s))
    ))
    (incf i 2)
  )
  res
)

(setq encode-hex-values '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 
    #\a #\b #\c #\d #\e #\f))

(defun encode-hex (s &aux (res (copy "")))
  (dolist (i s)
    (put res -1 ((/ i 16) encode-hex-values))
    (put res -1 ((mod i 16) encode-hex-values))
  )
  res
)
    
(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***