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