Annotation For lib/xvfs/xvfs.tcl

Origin for each line in lib/xvfs/xvfs.tcl from check-in 47dcf5fc27:

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