Lines of
lib/xvfs/xvfs.tcl
from check-in 0bdbe4333e
that are changed by the sequence of edits moving toward
check-in 702c74c153:
1: #! /usr/bin/env tclsh
2:
3: namespace eval ::xvfs {}
4:
5: # Functions
6: proc ::xvfs::_emitLine {line} {
7: ::minirivet::_emitOutput "${line}\n"
8: }
9:
10: proc ::xvfs::printHelp {channel {errors ""}} {
11: if {[llength $errors] != 0} {
12: foreach error $errors {
0bdbe4333e 2019-09-20 13: ::xvfs::_emitLine $channel "error: $error"
14: }
0bdbe4333e 2019-09-20 15: ::xvfs::_emitLine $channel ""
16: }
0bdbe4333e 2019-09-20 17: ::xvfs::_emitLine $channel "Usage: dir2c \[--help\] --directory <rootDirectory> --name <fsName>"
18: flush $channel
19: }
20:
21: proc ::xvfs::sanitizeCString {string} {
22: set output [join [lmap char [split $string ""] {
23: if {![regexp {[A-Za-z0-9./-]} $char]} {
24: binary scan $char H* char
25: set char "\\[format %03o 0x$char]"
26: }
27:
28: set char
29: }] ""]
30:
31: return $output
32: }
33:
34: proc ::xvfs::sanitizeCStringList {list {prefix ""} {width 80}} {
35: set lines [list]
36: set row [list]
37: foreach item $list {
38: lappend row "\"[sanitizeCString $item]\""
39:
40: set rowString [join $row {, }]
41: set rowString "${prefix}${rowString}"
42: if {[string length $rowString] > $width} {
43: set row [list]
44: lappend lines $rowString
45: unset rowString
46: }
47: }
48: if {[info exists rowString]} {
49: lappend lines $rowString
50: }
51:
52: return [join $lines "\n"]
53: }
54:
55: proc ::xvfs::binaryToCHex {binary {prefix ""} {width 10}} {
56: set binary [binary encode hex $binary]
57: set output [list]
58:
59: set width [expr {$width * 2}]
60: set stopAt [expr {$width - 1}]
61:
62: set offset 0
63: while 1 {
64: set row [string range $binary $offset [expr {$offset + $stopAt}]]
65: if {[string length $row] == 0} {
66: break
67: }
68: incr offset [string length $row]
69:
70: set rowOutput [list]
71: while {$row ne ""} {
72: set value [string range $row 0 1]
73: set row [string range $row 2 end]
74:
75: lappend rowOutput "\\x$value"
76: }
77: set rowOutput [join $rowOutput {}]
78: set rowOutput "${prefix}\"${rowOutput}\""
79: lappend output $rowOutput
80: }
81:
82: if {[llength $output] == 0} {
83: return "${prefix}\"\""
84: }
85:
86: set output [join $output "\n"]
87: }
88:
89: proc ::xvfs::processFile {fsName inputFile outputFile fileInfoDict} {
90: array set fileInfo $fileInfoDict
91:
92: switch -exact -- $fileInfo(type) {
93: "file" {
94: set type "XVFS_FILE_TYPE_REG"
95: set fd [open $inputFile]
96: fconfigure $fd -encoding binary -translation binary -blocking true
97: set data [read $fd]
98: set size [string length $data]
99: set data [string trimleft [binaryToCHex $data "\t\t\t"]]
100: close $fd
101: }
102: "directory" {
103: set type "XVFS_FILE_TYPE_DIR"
104: set children $fileInfo(children)
105: set size [llength $children]
106:
107: if {$size == 0} {
108: set children "NULL"
109: } else {
110: set children [string trimleft [sanitizeCStringList $children "\t\t\t"]]
111: # This initializes it using a C99 compound literal, C99 is required
112: set children "(const char *\[\]) \{$children\}"
113: }
114: }
115: default {
116: return -code error "Unable to process $inputFile, unknown type: $fileInfo(type)"
117: }
118: }
119:
120: ::xvfs::_emitLine "\t\{"
121: ::xvfs::_emitLine "\t\t.name = \"[sanitizeCString $outputFile]\","
122: ::xvfs::_emitLine "\t\t.type = $type,"
123: ::xvfs::_emitLine "\t\t.size = $size,"
124: switch -exact -- $fileInfo(type) {
125: "file" {
126: ::xvfs::_emitLine "\t\t.data.fileContents = (const unsigned char *) $data"
127: }
128: "directory" {
129: ::xvfs::_emitLine "\t\t.data.dirChildren = $children"
130: }
131: }
132: ::xvfs::_emitLine "\t\},"
133: }
134:
135: proc ::xvfs::processDirectory {fsName directory {subDirectory ""}} {
136: set subDirectories [list]
137: set outputFiles [list]
138: set workingDirectory [file join $directory $subDirectory]
139: set outputDirectory $subDirectory
140:
141: if {$subDirectory eq ""} {
142: set isTopLevel true
143: } else {
144: set isTopLevel false
145: }
146:
147: if {$isTopLevel} {
148: ::xvfs::_emitLine "static const struct xvfs_file_data xvfs_${fsName}_data\[\] = \{"
149: }
150:
151: # XXX:TODO: Include hidden files ?
152: set children [list]
153: foreach file [glob -nocomplain -tails -directory $workingDirectory *] {
154: if {$file in {. ..}} {
155: continue
156: }
157:
158: set inputFile [file join $workingDirectory $file]
159: set outputFile [file join $outputDirectory [encoding convertto utf-8 $file]]
160:
161: unset -nocomplain fileInfo
162: catch {
163: file lstat $inputFile fileInfo
164: }
165: if {![info exists fileInfo]} {
166: ::xvfs::_emitLine stderr "warning: Unable to access $inputFile, skipping"
167: }
168:
169: lappend children [file tail $file]
170:
171: if {$fileInfo(type) eq "directory"} {
172: lappend subDirectories $outputFile
173: continue
174: }
175:
176: processFile $fsName $inputFile $outputFile [array get fileInfo]
177: lappend outputFiles $outputFile
178: }
179:
180: foreach subDirectory $subDirectories {
181: lappend outputFiles {*}[processDirectory $fsName $directory $subDirectory]
182: }
183:
184: set inputFile $directory
185: set outputFile $outputDirectory
186: unset -nocomplain fileInfo
187: file stat $inputFile fileInfo
188: set fileInfo(children) $children
189:
190: processFile $fsName $inputFile $outputFile [array get fileInfo]
191: lappend outputFiles $outputFile
192:
193: if {$isTopLevel} {
194: ::xvfs::_emitLine "\};"
195: }
196:
197: return $outputFiles
198: }
199:
200: proc ::xvfs::main {argv} {
201: # Main entry point
202: ## 1. Parse arguments
203: if {[llength $argv] % 2 != 0} {
204: lappend argv ""
205: }
206:
207: foreach {arg val} $argv {
208: switch -exact -- $arg {
209: "--help" {
210: printHelp stdout
211: exit 0
212: }
213: "--directory" {
214: set rootDirectory $val
215: }
216: "--name" {
217: set fsName $val
218: }
219: "--output" {
220: # Ignored, handled as part of some other process
221: }
222: default {
223: printHelp stderr [list "Invalid option: $arg $val"]
224: exit 1
225: }
226: }
227: }
228:
229: ## 2. Validate arguments
230: set errors [list]
231: if {![info exists rootDirectory]} {
232: lappend errors "--directory must be specified"
233: }
234: if {![info exists fsName]} {
235: lappend errors "--name must be specified"
236: }
237:
238: if {[llength $errors] != 0} {
239: printHelp stderr $errors
240: exit 1
241: }
242:
243: ## 3. Start processing directory and producing initial output
244: set ::xvfs::outputFiles [processDirectory $fsName $rootDirectory]
245:
246: set ::xvfs::fsName $fsName
247: set ::xvfs::rootDirectory $rootDirectory
248: }
249:
250: package provide xvfs 1