Posted to tcl by hypnotoad at Fri Sep 20 13:58:56 GMT 2019view raw

  1. #! /usr/bin/env tclsh
  2.  
  3. namespace eval ::practcl::xvfs {}
  4.  
  5. # Functions
  6. proc ::practcl::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 ::practcl::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 ::practcl::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 ::practcl::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 ::practcl::xvfs::processFile {resultVar fsName inputFile outputFile fileInfoDict} {
  86. upvar 1 $resultVar result
  87. array set fileInfo $fileInfoDict
  88.  
  89. switch -exact -- $fileInfo(type) {
  90. "file" {
  91. set type "XVFS_FILE_TYPE_REG"
  92. set fd [open $inputFile]
  93. fconfigure $fd -encoding binary -translation binary -blocking true
  94. set data [read $fd]
  95. set size [string length $data]
  96. set data [string trimleft [binaryToCHex $data "\t\t\t"]]
  97. close $fd
  98. }
  99. "directory" {
  100. set type "XVFS_FILE_TYPE_DIR"
  101. set children $fileInfo(children)
  102. set size [llength $children]
  103.  
  104. if {$size == 0} {
  105. set children "NULL"
  106. } else {
  107. set children [string trimleft [sanitizeCStringList $children "\t\t\t"]]
  108. # This initializes it using a C99 compound literal, C99 is required
  109. set children "(const char *\[\]) \{$children\}"
  110. }
  111. }
  112. default {
  113. return -code error "Unable to process $inputFile, unknown type: $fileInfo(type)"
  114. }
  115. }
  116.  
  117. ::clay::putb result "\t\{"
  118. ::clay::putb result "\t\t.name = \"[sanitizeCString $outputFile]\","
  119. ::clay::putb result "\t\t.type = $type,"
  120. ::clay::putb result "\t\t.size = $size,"
  121. switch -exact -- $fileInfo(type) {
  122. "file" {
  123. ::clay::putb result "\t\t.data.fileContents = (const unsigned char *) $data"
  124. }
  125. "directory" {
  126. ::clay::putb result "\t\t.data.dirChildren = $children"
  127. }
  128. }
  129. ::clay::putb result "\t\},"
  130. }
  131.  
  132. proc ::practcl::xvfs::processDirectory {resultVar fsName directory {subDirectory ""}} {
  133. upvar 1 $resultVar result
  134. set subDirectories [list]
  135. set outputFiles [list]
  136. set workingDirectory [file join $directory $subDirectory]
  137. set outputDirectory $subDirectory
  138.  
  139. if {$subDirectory eq ""} {
  140. set isTopLevel true
  141. } else {
  142. set isTopLevel false
  143. }
  144.  
  145. if {$isTopLevel} {
  146. ::clay::putb result "static const struct xvfs_file_data xvfs_${fsName}_data\[\] = \{"
  147. }
  148.  
  149. # XXX:TODO: Include hidden files ?
  150. set children [list]
  151. foreach file [glob -nocomplain -tails -directory $workingDirectory *] {
  152. if {$file in {. ..}} {
  153. continue
  154. }
  155.  
  156. set inputFile [file join $workingDirectory $file]
  157. set outputFile [file join $outputDirectory [encoding convertto utf-8 $file]]
  158.  
  159. unset -nocomplain fileInfo
  160. catch {
  161. file lstat $inputFile fileInfo
  162. }
  163. if {![info exists fileInfo]} {
  164. puts stderr "warning: Unable to access $inputFile, skipping"
  165. }
  166.  
  167. lappend children [file tail $file]
  168.  
  169. if {$fileInfo(type) eq "directory"} {
  170. lappend subDirectories $outputFile
  171. continue
  172. }
  173.  
  174. processFile result $fsName $inputFile $outputFile [array get fileInfo]
  175. lappend outputFiles $outputFile
  176. }
  177.  
  178. foreach subDirectory $subDirectories {
  179. lappend outputFiles {*}[processDirectory result $fsName $directory $subDirectory]
  180. }
  181.  
  182. set inputFile $directory
  183. set outputFile $outputDirectory
  184. unset -nocomplain fileInfo
  185. file stat $inputFile fileInfo
  186. set fileInfo(children) $children
  187.  
  188. processFile result $fsName $inputFile $outputFile [array get fileInfo]
  189. lappend outputFiles $outputFile
  190.  
  191. if {$isTopLevel} {
  192. ::clay::putb result "\};"
  193. }
  194.  
  195. return $outputFiles
  196. }
  197.  
  198. proc ::practcl::xvfs::main {argv} {
  199. # Main entry point
  200. ## 1. Parse arguments
  201. if {[llength $argv] % 2 != 0} {
  202. lappend argv ""
  203. }
  204.  
  205. foreach {arg val} $argv {
  206. switch -exact -- $arg {
  207. "--help" {
  208. printHelp stdout
  209. exit 0
  210. }
  211. "--directory" {
  212. set rootDirectory $val
  213. }
  214. "--name" {
  215. set fsName $val
  216. }
  217. default {
  218. printHelp stderr [list "Invalid option: $arg $val"]
  219. exit 1
  220. }
  221. }
  222. }
  223.  
  224. ## 2. Validate arguments
  225. set errors [list]
  226. if {![info exists rootDirectory]} {
  227. lappend errors "--directory must be specified"
  228. }
  229. if {![info exists fsName]} {
  230. lappend errors "--name must be specified"
  231. }
  232.  
  233. if {[llength $errors] != 0} {
  234. printHelp stderr $errors
  235. exit 1
  236. }
  237.  
  238. ## 3. Start processing directory and producing initial output
  239. set ::practcl::xvfs::outputFiles [processDirectory result $fsName $rootDirectory]
  240. set ::practcl::xvfs::fsName $fsName
  241. set ::practcl::xvfs::rootDirectory $rootDirectory
  242. }
  243.  
  244. package provide xvfs 1
  245.