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