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