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