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