Annotation For lib/xvfs/xvfs.tcl

Origin for each line in lib/xvfs/xvfs.tcl from check-in 30c469fcf7:

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