Check-in [b37f8d7df9]
Overview
SHA1:b37f8d7df9e695f6006f28a555b47e085b98e9b9
Date: 2014-10-30 15:52:43
User: rkeene
Comment:Added some basic UNIX commands
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | folders | manifest
Tags And Properties
Context
2014-10-30
19:16
[4ee619220a] Added "ps" command (user: rkeene, tags: trunk)
15:52
[b37f8d7df9] Added some basic UNIX commands (user: rkeene, tags: trunk)
2014-10-29
18:14
[ee22fadb48] Removed skipping of "size" request (user: rkeene, tags: trunk)
Changes

Modified tuapi.tcl from [741721e332] to [0e870c7074].

   251    251   				::tuapi::syscall::ifconfig $interface flags $flags
   252    252   			}
   253    253   
   254    254   		}
   255    255   	}
   256    256   }
   257    257   
   258         -proc ::tuapi::internal::foreach_line {fd sep code} {
          258  +proc ::tuapi::helper::foreach_line {fd sep code} {
   259    259   	while {![eof $fd]} {
   260    260   		gets $fd line
   261    261   
   262    262   		regsub { *#.*$} $line {} line
   263    263   
   264    264   		if {$line == ""} {
   265    265   			continue
................................................................................
   276    276   proc ::tuapi::modprobe args {
   277    277   	# Set module base directory
   278    278   	set modules_dir [file join /lib/modules $::tcl_platform(osVersion)]
   279    279   
   280    280   	# Load device names
   281    281   	set devnames_file [file join $modules_dir modules.devname]
   282    282   	set fd [open $devnames_file]
   283         -	::tuapi::internal::foreach_line $fd " " {
          283  +	::tuapi::helper::foreach_line $fd " " {
   284    284   		set module [lindex $line 0]
   285    285   		set device [lindex $line 1]
   286    286   		set id [lindex $line 2]
   287    287   
   288    288   		set id_type [string index $id 0]
   289    289   		set id_type [string map [list "c" "char" "b" "block"] $id_type]
   290    290   		set id [split [string range $id 1 end] :]
................................................................................
   294    294   		set alias2module($id_alias) $module
   295    295   	}
   296    296   	close $fd
   297    297   
   298    298   	# Load aliases
   299    299   	set aliases_file [file join $modules_dir modules.alias]
   300    300   	set fd [open $aliases_file]
   301         -	::tuapi::internal::foreach_line $fd " " {
          301  +	::tuapi::helper::foreach_line $fd " " {
   302    302   		set alias [lindex $line 1]
   303    303   		set module [lindex $line 2]
   304    304   
   305    305   		set alias2module($alias) $module
   306    306   	}
   307    307   	close $fd
   308    308   
   309    309   	# Load dependencies
   310    310   	set deps_file [file join $modules_dir modules.dep]
   311    311   	set fd [open $deps_file]
   312         -	::tuapi::internal::foreach_line $fd ":" {
          312  +	::tuapi::helper::foreach_line $fd ":" {
   313    313   		set module [string trim [lindex $line 0]]
   314    314   		set deps [split [string trim [join [lrange $line 1 end]]]]
   315    315   
   316    316   		set module_basename [file rootname [file tail $module]]
   317    317   		set module_basename_alt1 [string map [list "_" "-"] $module_basename]
   318    318   		set module_basename_alt2 [string map [list "-" "_"] $module_basename]
   319    319   
................................................................................
   354    354   				set module [file join $modules_dir $module]
   355    355   
   356    356   				::tuapi::syscall::insmod $module
   357    357   			}
   358    358   		}
   359    359   	}
   360    360   }
          361  +
          362  +# Create UNIX-like procs meant to be used interactively
          363  +proc ::tuapi::create_unix_commands {} {
          364  +	proc ::cat args {
          365  +		foreach file $args {
          366  +			if {[catch {
          367  +				set fd [open $file]
          368  +			} err]} {
          369  +				puts stderr "Unable to open \"$file\": $err"
          370  +
          371  +				continue
          372  +			}
          373  +
          374  +			fcopy $fd stdout
          375  +			close $fd
          376  +		}
          377  +	}
          378  +
          379  +	proc ::ls args {
          380  +		set options(long) 0
          381  +		set options(one) 0
          382  +		set options(skipdot) 1
          383  +		set options(norecurseintotopleveldirs) 0
          384  +
          385  +		set idx 0
          386  +		foreach arg $args {
          387  +			if {[string match "-*" $arg]} {
          388  +				set args [lreplace $args $idx $idx]
          389  +				if {$arg == "--"} {
          390  +					break
          391  +				}
          392  +
          393  +				if {[string range $arg 0 1] == "--"} {
          394  +					set opts [list [string range $arg 2 end]]
          395  +				} else {
          396  +					set opts [split [string range $arg 1 end] ""]
          397  +				}
          398  +
          399  +				foreach opt $opts {
          400  +					switch -- $opt {
          401  +						"l" {
          402  +							set options(long) 1
          403  +							set options(one) 0
          404  +						}
          405  +						"1" {
          406  +							set options(one) 1
          407  +							set options(long) 0
          408  +						}
          409  +						"d" {
          410  +							set options(norecurseintotopleveldirs) 1
          411  +						}
          412  +						"a" {
          413  +							set options(skipdot) 0
          414  +						}
          415  +					}
          416  +				}
          417  +
          418  +				continue
          419  +			}
          420  +
          421  +			incr idx
          422  +		}
          423  +
          424  +		if {[llength $args] == 0} {
          425  +			set args [list "."]
          426  +		}
          427  +
          428  +		set nodes [list]
          429  +		foreach arg $args {
          430  +			unset -nocomplain fileinfo
          431  +			catch {
          432  +				file stat $arg fileinfo
          433  +			}
          434  +
          435  +			if {![info exists fileinfo]} {
          436  +				puts stderr "No such file or directory: $arg"
          437  +
          438  +				continue
          439  +			}
          440  +
          441  +			if {$fileinfo(type) == "directory"} {
          442  +				if {$options(norecurseintotopleveldirs)} {
          443  +					lappend nodes $arg
          444  +				} else {
          445  +					lappend nodes {*}[glob -nocomplain -directory $arg -tails *]
          446  +				}
          447  +			} else {
          448  +				lappend nodes $arg
          449  +			}
          450  +
          451  +		}
          452  +
          453  +		set newline_required 0
          454  +		foreach node $nodes {
          455  +			unset -nocomplain fileinfo
          456  +
          457  +			if {$options(one)} {
          458  +				puts $node
          459  +			} elseif {$options(long)} {
          460  +				catch {
          461  +					file stat $node fileinfo
          462  +				}
          463  +
          464  +				if {![info exists fileinfo]} {
          465  +					array set fileinfo [list mode 0 nlink 0 uid -1 gid -1 size 0 mtime 0]
          466  +				}
          467  +
          468  +				set date [clock format $fileinfo(mtime) -format {%b %e %H:%M}]
          469  +
          470  +				switch -- $fileinfo(type) {
          471  +					"directory" {
          472  +						set typeid "d"
          473  +					}
          474  +					"blockSpecial" {
          475  +						set typeid "b"
          476  +					}
          477  +					"characterSpecial" {
          478  +						set typeid "c"
          479  +					}
          480  +					"file" {
          481  +						set typeid "-"
          482  +					}
          483  +					"socket" {
          484  +						set typeid "s"
          485  +					}
          486  +					default {
          487  +						set typeid "?"
          488  +					}
          489  +				}
          490  +
          491  +				puts [format {%s%04o %5s %6s %6s %10s %12s %s} $typeid [expr {$fileinfo(mode) & 07777}] $fileinfo(nlink) $fileinfo(uid) $fileinfo(gid) $fileinfo(size) $date $node]
          492  +
          493  +			} else {
          494  +				puts -nonewline "$node "
          495  +				set newline_required 1
          496  +			}
          497  +		}
          498  +
          499  +		if {$newline_required} {
          500  +			puts ""
          501  +		}
          502  +	}
          503  +
          504  +	proc ::modprobe args {
          505  +		::tuapi::modprobe {*}$args
          506  +	}
          507  +}