Added merge-overlay.lsp utility for merging down an overlay.
[rrq/fusefile.git] / merge-overlay.lsp
1 #!/usr/bin/newlisp
2
3 ;
4 ; Copy from a fusefile overlay file onto a fusefile. This may be done
5 ; so as to "merge down" an overlay in an overlay stack. Eg, assume the
6 ; original fusefile had overlay stack A:B:C then C could be merged
7 ; onto an A:B stack, or B merged onto A; the latter allowing a
8 ; subsequent A:C stack corresponding to previous A:B:C.
9 ;
10 ; Arguments: <fusefile> <overlay>
11
12 (map set '(FUSEFILE OVERLAY) (-2 (main-args)))
13
14 (setf FF.fd (open FUSEFILE "u") OL.fd (open OVERLAY "r"))
15
16 (define (die)
17   (write-line 2 (join (map string (args)) " "))
18   (exit 1))
19
20 ; Read N unsigned 64-bit integers from OL.fd, returned as a list of them.
21 (define (rd-uint64 FD N)
22   (let ((B (* N 8)) (BUFFER nil) (HEAD "") (OUT '()))
23     (while (and (> B) (> (read FD BUFFER B)))
24       (dec B (length BUFFER))
25       (extend HEAD BUFFER)
26       (let ((I (/ (length HEAD) 8)))
27         (when (> I)
28           (extend OUT (unpack (dup "Lu" ) HEAD))
29           (setf HEAD ((* 8 I) HEAD)))))
30     (when (> B) (die "Cannot read" N "table entries"))
31     OUT))
32
33 (define (copy-data AT SIZE)
34   (let ((BUFFER nil) (N 0))
35     (when (null? (seek FF.fd AT)) (die "Cannot seek" FUSEFILE AT))
36     (when (null? (seek OL.fd AT)) (die "Cannot seek" OVERLAY AT))
37     (while (> SIZE)
38       (when (<= (read OL.fd BUFFER SIZE)) (die "Failed reading" SIZE "bytes"))
39       (dec SIZE (length BUFFER))
40       (while (and (> (length BUFFER))
41                   (setf N (write FF.fd BUFFER (length BUFFER))))
42         (setf BUFFER (N BUFFER)))
43       (when (> (length BUFFER)) (die "Failed writing" AT SIZE ))
44       )))
45
46 (when (< FF.fd) (die "Cannot open" FUSEFILE))
47 (when (< OL.fd) (die "Cannot open" OVERLAY))
48
49 (when (null?  (seek OL.fd (setf P (file-info FUSEFILE 0))))
50   (die "Seek error:" P))
51
52 (setf N (rd-uint64 OL.fd 1))
53 (when (null? N) (die "Cannot read" OVERLAY "table count."))
54 (setf N (N 0))
55
56 ; Check size
57 (when (!= (+ P 8 (* N 16)) (file-info OVERLAY 0))
58   (die "Wrong size for " OVERLAY "which should be" (+ P 8 (* N 16))))
59
60 (setf TABLE (rd-uint64 OL.fd (* 2 N)))
61 (when (null? TABLE) (die "Cannot read" OVERLAY "table"))
62
63 (dolist (ENTRY (explode TABLE 2))
64   (println (format "copy %s/%d:%d" (cons OVERLAY ENTRY)))
65   (copy-data (ENTRY 0) (- (ENTRY 1) (ENTRY 0))))
66
67 "dumpoverlay.lsp"
68 (exit 0)