Check-in [882f8b5c54]
Overview
SHA1:882f8b5c540cc3465c874a4011cc6750940f9f3b
Date: 2014-12-15 16:55:42
User: rkeene
Comment:Updated to support scanning /sys/devices for modules to load
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | folders | manifest
Tags And Properties
Context
2014-12-15
17:03
[eee347afac] Corrected typo in previous commit (user: rkeene, tags: trunk)
16:55
[882f8b5c54] Updated to support scanning /sys/devices for modules to load (user: rkeene, tags: trunk)
16:19
[8a0dedb7c5] Added wildcard matching to modprobe (user: rkeene, tags: trunk)
Changes

Modified test.tcl from [3abe608065] to [b4d36d4339].

     1      1   #! /usr/bin/env tclsh
     2      2   
     3      3   puts [exec ./build-dyn.sh]
     4      4   
     5      5   load ./tuapi.so
     6      6   
     7         -::tuapi::modprobe pci:v000014E4d0000164Csv00001028sd000001B3bc03sc00i00
            7  +puts [::tuapi::scan_and_load_kernel_modules]
     8      8   
     9      9   #foreach x [list AS CORE CPU DATA FSIZE LOCKS MEMLOCK MSGQUEUE NICE NOFILE OFILE NPROC RSS RTPRIO RTTIME SIGPENDING STACK] {
    10     10   #	puts "\t\tcase [format 0x%xLU [::tuapi::internal::hash $x]]: /* $x */"
    11     11   #	puts "\t\t\tresource_id = RLIMIT_$x;"
    12     12   #	puts "\t\t\tbreak;"
    13     13   #}
    14     14   #exit

Modified tuapi.tcl from [f69d9c9167] to [7cc91409f0].

     1      1   #! /usr/bin/env tclsh
     2      2   
     3      3   namespace eval ::tuapi {}
     4      4   namespace eval ::tuapi::helper {}
            5  +namespace eval ::tuapi::cache {}
     5      6   
     6      7   set ::tuapi::_mount_flags(bind) BIND
     7      8   set ::tuapi::_mount_flags(move) MOVE
     8      9   set ::tuapi::_mount_flags(remount) REMOUNT
     9     10   set ::tuapi::_mount_flags(mandlock) MANDLOCK
    10     11   set ::tuapi::_mount_flags(dirsync) DIRSYNC
    11     12   set ::tuapi::_mount_flags(noatime) NOATIME
................................................................................
   287    288   		set line [split $line $sep]
   288    289   
   289    290   		uplevel 1 [list set line $line]
   290    291   		uplevel 1 $code
   291    292   	}
   292    293   	uplevel 1 [list unset -nocomplain line]
   293    294   }
          295  +
          296  +proc ::tuapi::helper::recursive_glob {path pattern code {depth 1}} {
          297  +	foreach filename [glob -nocomplain -directory $path -type f $pattern] {
          298  +		uplevel $depth [list set filename $filename]
          299  +		uplevel $depth $code
          300  +	}
          301  +
          302  +	incr depth
          303  +
          304  +	foreach dirname [glob -nocomplain -directory $path -type d *] {
          305  +		set dirinfo(type) unknown
          306  +		catch {
          307  +			file lstat $dirname dirinfo
          308  +		}
          309  +
          310  +		if {$dirinfo(type) == "link"} {
          311  +			continue
          312  +		}
          313  +
          314  +		::tuapi::helper::recursive_glob $dirname $pattern $code $depth
          315  +	}
          316  +}
   294    317   
   295    318   proc ::tuapi::modprobe args {
          319  +	# Process arguments
          320  +	set options(call_insmod) 1
          321  +	set idx 0
          322  +	foreach arg $args {
          323  +		switch -- $arg {
          324  +			"-dontload" {
          325  +				set options(call_insmod) 0
          326  +			}
          327  +			"--" {
          328  +				incr idx
          329  +				break
          330  +			}
          331  +			default {
          332  +				break
          333  +			}
          334  +		}
          335  +
          336  +		incr idx
          337  +	}
          338  +	set args [lrange $args $idx end]
          339  +
          340  +	# Set initial retval
          341  +	set retval [list]
          342  +
   296    343   	# Set module base directory
   297    344   	set modules_dir [file join /lib/modules $::tcl_platform(osVersion)]
   298    345   
   299    346   	# Load device names
   300         -	set devnames_file [file join $modules_dir modules.devname]
   301         -	set fd [open $devnames_file]
   302         -	::tuapi::helper::foreach_line $fd " " {
   303         -		set module [lindex $line 0]
   304         -		set device [lindex $line 1]
   305         -		set id [lindex $line 2]
   306         -
   307         -		set id_type [string index $id 0]
   308         -		set id_type [string map [list "c" "char" "b" "block"] $id_type]
   309         -		set id [split [string range $id 1 end] :]
   310         -		set id_alias "${id_type}-major-[lindex $id 0]-[lindex $id 1]"
   311         -
   312         -		set "alias2module(/dev/${device})" $module
   313         -		set alias2module($id_alias) $module
   314         -	}
   315         -	close $fd
   316         -
   317         -	# Load aliases
   318         -	set aliases_file [file join $modules_dir modules.alias]
   319         -	set fd [open $aliases_file]
   320         -	::tuapi::helper::foreach_line $fd " " {
   321         -		set alias [lindex $line 1]
   322         -		set module [lindex $line 2]
   323         -
   324         -		set alias2module($alias) $module
   325         -		if {[string match {*\**} $alias]} {
   326         -			set alias2module_wildcards($alias) $module
   327         -		}
   328         -	}
   329         -	close $fd
   330         -
   331         -	# Load dependencies
   332         -	set deps_file [file join $modules_dir modules.dep]
   333         -	set fd [open $deps_file]
   334         -	::tuapi::helper::foreach_line $fd ":" {
   335         -		set module [string trim [lindex $line 0]]
   336         -		set deps [split [string trim [join [lrange $line 1 end]]]]
   337         -
   338         -		set module_basename [file rootname [file tail $module]]
   339         -		set module_basename_alt1 [string map [list "_" "-"] $module_basename]
   340         -		set module_basename_alt2 [string map [list "-" "_"] $module_basename]
   341         -
   342         -		set alias2module($module_basename) $module
   343         -		set alias2module($module_basename_alt1) $module
   344         -		set alias2module($module_basename_alt2) $module
   345         -
   346         -		if {[llength $deps] != 0} {
   347         -			set module2deps($module) $deps
   348         -		}
   349         -	}
   350         -	close $fd
          347  +	if {![info exists ::tuapi::cache::alias2module]} {
          348  +		set devnames_file [file join $modules_dir modules.devname]
          349  +		set fd [open $devnames_file]
          350  +		::tuapi::helper::foreach_line $fd " " {
          351  +			set module [lindex $line 0]
          352  +			set device [lindex $line 1]
          353  +			set id [lindex $line 2]
          354  +
          355  +			set id_type [string index $id 0]
          356  +			set id_type [string map [list "c" "char" "b" "block"] $id_type]
          357  +			set id [split [string range $id 1 end] :]
          358  +			set id_alias "${id_type}-major-[lindex $id 0]-[lindex $id 1]"
          359  +
          360  +			set "alias2module(/dev/${device})" $module
          361  +			set alias2module($id_alias) $module
          362  +		}
          363  +		close $fd
          364  +
          365  +		# Load aliases
          366  +		set aliases_file [file join $modules_dir modules.alias]
          367  +		set fd [open $aliases_file]
          368  +		::tuapi::helper::foreach_line $fd " " {
          369  +			set alias [lindex $line 1]
          370  +			set module [lindex $line 2]
          371  +
          372  +			set alias2module($alias) $module
          373  +			if {[string match {*\**} $alias]} {
          374  +				set alias2module_wildcards($alias) $module
          375  +			}
          376  +		}
          377  +		close $fd
          378  +
          379  +		# Load dependencies
          380  +		set deps_file [file join $modules_dir modules.dep]
          381  +		set fd [open $deps_file]
          382  +		::tuapi::helper::foreach_line $fd ":" {
          383  +			set module [string trim [lindex $line 0]]
          384  +			set deps [split [string trim [join [lrange $line 1 end]]]]
          385  +
          386  +			set module_basename [file rootname [file tail $module]]
          387  +			set module_basename_alt1 [string map [list "_" "-"] $module_basename]
          388  +			set module_basename_alt2 [string map [list "-" "_"] $module_basename]
          389  +
          390  +			set alias2module($module_basename) $module
          391  +			set alias2module($module_basename_alt1) $module
          392  +			set alias2module($module_basename_alt2) $module
          393  +
          394  +			if {[llength $deps] != 0} {
          395  +				set module2deps($module) $deps
          396  +			}
          397  +		}
          398  +		close $fd
          399  +
          400  +		set ::tuapi::cache::alias2module [array get alias2module]
          401  +		set ::tuapi::cache::alias2module_wildcards [array get alias2module_wildcards]
          402  +		set ::tuapi::cache::module2deps [array get module2deps]
          403  +	} else {
          404  +		array set alias2module $::tuapi::cache::alias2module
          405  +		array set alias2module_wildcards $::tuapi::cache::alias2module_wildcards
          406  +		array set module2deps $::::tuapi::cache::module2deps
          407  +	}
   351    408   
   352    409   	# Load modules
   353    410   	foreach modules $args {
   354    411   		foreach module $modules {
          412  +			# If the module is given as an absolute path, ignore the path
          413  +			# and process just as we would if the name were given alone
          414  +			# This may be wrong, but otherwise dependency matching would
          415  +			# be harder
          416  +			if {[string index $module 0] == "/" && [file exists $module]} {
          417  +				set module [file rootname [file tail]]
          418  +			}
          419  +
   355    420   			for {set try 0} {$try < 100} {incr try} {
   356    421   				if {![info exists alias2module($module)]} {
   357    422   					# If no exact match found, process wildcard entries
   358    423   					set found_wildcard_match 0
   359    424   					foreach alias [array name alias2module_wildcards] {
   360    425   						if {[string match $alias $module]} {
   361    426   							set module $alias2module_wildcards($alias)
................................................................................
   385    450   			foreach module $load {
   386    451   				if {[string match "/dev/*" $module]} {
   387    452   					return -code error "Unable to lookup device node module for $module"
   388    453   				}
   389    454   
   390    455   				set module [file join $modules_dir $module]
   391    456   
   392         -				::tuapi::syscall::insmod $module
          457  +				if {$options(call_insmod)} {
          458  +					::tuapi::syscall::insmod $module
          459  +				}
          460  +
          461  +				lappend retval $module
   393    462   			}
   394    463   		}
   395    464   	}
          465  +
          466  +	return $retval
          467  +}
          468  +
          469  +# Scan the various buses attached to the system and load the appropriate
          470  +# kernel modules
          471  +proc ::tuapi::scan_and_load_kernel_modules {{rescan_hardware 0}} {
          472  +	set modules [list]
          473  +
          474  +	# Determine which modules are already loaded
          475  +	foreach module [glob -tails -nocomplain -directory /sys/module -type d *] {
          476  +		set alt_module1 [string map [list "_" "-"] $module]
          477  +		set alt_module2 [string map [list "-" "_"] $module]
          478  +
          479  +		set loaded($module) 1
          480  +		set loaded($alt_module1) 1
          481  +		set loaded($alt_module2) 1
          482  +	}
          483  +
          484  +	::tuapi::helper::recursive_glob /sys/devices modalias {
          485  +		set fd [open $filename r]
          486  +		::tuapi::helper::foreach_line $fd "\n" {
          487  +			foreach module [::tuapi::modprobe -dontload -- $line] {
          488  +				if {[lsearch -exact $modules $module] != -1} {
          489  +					continue
          490  +				}
          491  +
          492  +				if {![file exists $module]} {
          493  +					continue
          494  +				}
          495  +
          496  +				set rootname [file rootname [file tail $module]]
          497  +				if {[info exists loaded($rootname)]} {
          498  +					continue
          499  +				}
          500  +
          501  +				lappend modules $module
          502  +			}
          503  +		}
          504  +		close $fd
          505  +	}
          506  +
          507  +	set failed_to_load [list]
          508  +	set able_to_load [list]
          509  +	foreach module $modules {
          510  +		if {[catch {
          511  +			::tuapi::modprobe $module
          512  +		}]} {
          513  +			lappend failed_to_load $module
          514  +		} else {
          515  +			lappend able_to_load $module
          516  +		}
          517  +	}
................................................................................
          518  +
          519  +	return [list -failed $failed_to_load -loaded $able_to_load]
   396    520   }
   397    521   
   398    522   # Create UNIX-like procs meant to be used interactively
   399    523   proc ::tuapi::create_unix_commands {} {
   400    524   	proc ::cat args {
   401    525   		foreach file $args {
   402    526   			if {[catch {