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
2
3
4
5
6
7
8
9
10
11
12
13
14
#! /usr/bin/env tclsh

puts [exec ./build-dyn.sh]

load ./tuapi.so

::tuapi::modprobe pci:v000014E4d0000164Csv00001028sd000001B3bc03sc00i00

#foreach x [list AS CORE CPU DATA FSIZE LOCKS MEMLOCK MSGQUEUE NICE NOFILE OFILE NPROC RSS RTPRIO RTTIME SIGPENDING STACK] {
#	puts "\t\tcase [format 0x%xLU [::tuapi::internal::hash $x]]: /* $x */"
#	puts "\t\t\tresource_id = RLIMIT_$x;"
#	puts "\t\t\tbreak;"
#}
#exit






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
#! /usr/bin/env tclsh

puts [exec ./build-dyn.sh]

load ./tuapi.so

puts [::tuapi::scan_and_load_kernel_modules]

#foreach x [list AS CORE CPU DATA FSIZE LOCKS MEMLOCK MSGQUEUE NICE NOFILE OFILE NPROC RSS RTPRIO RTTIME SIGPENDING STACK] {
#	puts "\t\tcase [format 0x%xLU [::tuapi::internal::hash $x]]: /* $x */"
#	puts "\t\t\tresource_id = RLIMIT_$x;"
#	puts "\t\t\tbreak;"
#}
#exit

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

1
2
3
4

5
6
7
8
9
10
11
...
287
288
289
290
291
292
293
294






















295
























296
297
298
299

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351









352
353
354








355
356
357
358
359
360
361
...
385
386
387
388
389
390
391

392
393
394

395























































...


396
397
398
399
400
401
402
#! /usr/bin/env tclsh

namespace eval ::tuapi {}
namespace eval ::tuapi::helper {}


set ::tuapi::_mount_flags(bind) BIND
set ::tuapi::_mount_flags(move) MOVE
set ::tuapi::_mount_flags(remount) REMOUNT
set ::tuapi::_mount_flags(mandlock) MANDLOCK
set ::tuapi::_mount_flags(dirsync) DIRSYNC
set ::tuapi::_mount_flags(noatime) NOATIME
................................................................................
		set line [split $line $sep]

		uplevel 1 [list set line $line]
		uplevel 1 $code
	}
	uplevel 1 [list unset -nocomplain line]
}























proc ::tuapi::modprobe args {
























	# Set module base directory
	set modules_dir [file join /lib/modules $::tcl_platform(osVersion)]

	# Load device names

	set devnames_file [file join $modules_dir modules.devname]
	set fd [open $devnames_file]
	::tuapi::helper::foreach_line $fd " " {
		set module [lindex $line 0]
		set device [lindex $line 1]
		set id [lindex $line 2]

		set id_type [string index $id 0]
		set id_type [string map [list "c" "char" "b" "block"] $id_type]
		set id [split [string range $id 1 end] :]
		set id_alias "${id_type}-major-[lindex $id 0]-[lindex $id 1]"

		set "alias2module(/dev/${device})" $module
		set alias2module($id_alias) $module
	}
	close $fd

	# Load aliases
	set aliases_file [file join $modules_dir modules.alias]
	set fd [open $aliases_file]
	::tuapi::helper::foreach_line $fd " " {
		set alias [lindex $line 1]
		set module [lindex $line 2]

		set alias2module($alias) $module
		if {[string match {*\**} $alias]} {
			set alias2module_wildcards($alias) $module
		}
	}
	close $fd

	# Load dependencies
	set deps_file [file join $modules_dir modules.dep]
	set fd [open $deps_file]
	::tuapi::helper::foreach_line $fd ":" {
		set module [string trim [lindex $line 0]]
		set deps [split [string trim [join [lrange $line 1 end]]]]

		set module_basename [file rootname [file tail $module]]
		set module_basename_alt1 [string map [list "_" "-"] $module_basename]
		set module_basename_alt2 [string map [list "-" "_"] $module_basename]

		set alias2module($module_basename) $module
		set alias2module($module_basename_alt1) $module
		set alias2module($module_basename_alt2) $module

		if {[llength $deps] != 0} {
			set module2deps($module) $deps
		}
	}
	close $fd










	# Load modules
	foreach modules $args {
		foreach module $modules {








			for {set try 0} {$try < 100} {incr try} {
				if {![info exists alias2module($module)]} {
					# If no exact match found, process wildcard entries
					set found_wildcard_match 0
					foreach alias [array name alias2module_wildcards] {
						if {[string match $alias $module]} {
							set module $alias2module_wildcards($alias)
................................................................................
			foreach module $load {
				if {[string match "/dev/*" $module]} {
					return -code error "Unable to lookup device node module for $module"
				}

				set module [file join $modules_dir $module]


				::tuapi::syscall::insmod $module
			}
		}

	}























































................................................................................


}

# Create UNIX-like procs meant to be used interactively
proc ::tuapi::create_unix_commands {} {
	proc ::cat args {
		foreach file $args {
			if {[catch {




>







 








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>




>
|
|
|
|
|
|

|
|
|
|

|
|
|
|

|
|
|
|
|
|

|
|
|
|
|
|

|
|
|
|
|
|

|
|
|

|
|
|

|
|
|
|
|

>
>
>
>
>
>
>
>
>



>
>
>
>
>
>
>
>







 







>
|
|
|
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
 
>
>







1
2
3
4
5
6
7
8
9
10
11
12
...
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
...
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
...
518
519
520
521
522
523
524
525
526
#! /usr/bin/env tclsh

namespace eval ::tuapi {}
namespace eval ::tuapi::helper {}
namespace eval ::tuapi::cache {}

set ::tuapi::_mount_flags(bind) BIND
set ::tuapi::_mount_flags(move) MOVE
set ::tuapi::_mount_flags(remount) REMOUNT
set ::tuapi::_mount_flags(mandlock) MANDLOCK
set ::tuapi::_mount_flags(dirsync) DIRSYNC
set ::tuapi::_mount_flags(noatime) NOATIME
................................................................................
		set line [split $line $sep]

		uplevel 1 [list set line $line]
		uplevel 1 $code
	}
	uplevel 1 [list unset -nocomplain line]
}

proc ::tuapi::helper::recursive_glob {path pattern code {depth 1}} {
	foreach filename [glob -nocomplain -directory $path -type f $pattern] {
		uplevel $depth [list set filename $filename]
		uplevel $depth $code
	}

	incr depth

	foreach dirname [glob -nocomplain -directory $path -type d *] {
		set dirinfo(type) unknown
		catch {
			file lstat $dirname dirinfo
		}

		if {$dirinfo(type) == "link"} {
			continue
		}

		::tuapi::helper::recursive_glob $dirname $pattern $code $depth
	}
}

proc ::tuapi::modprobe args {
	# Process arguments
	set options(call_insmod) 1
	set idx 0
	foreach arg $args {
		switch -- $arg {
			"-dontload" {
				set options(call_insmod) 0
			}
			"--" {
				incr idx
				break
			}
			default {
				break
			}
		}

		incr idx
	}
	set args [lrange $args $idx end]

	# Set initial retval
	set retval [list]

	# Set module base directory
	set modules_dir [file join /lib/modules $::tcl_platform(osVersion)]

	# Load device names
	if {![info exists ::tuapi::cache::alias2module]} {
		set devnames_file [file join $modules_dir modules.devname]
		set fd [open $devnames_file]
		::tuapi::helper::foreach_line $fd " " {
			set module [lindex $line 0]
			set device [lindex $line 1]
			set id [lindex $line 2]

			set id_type [string index $id 0]
			set id_type [string map [list "c" "char" "b" "block"] $id_type]
			set id [split [string range $id 1 end] :]
			set id_alias "${id_type}-major-[lindex $id 0]-[lindex $id 1]"

			set "alias2module(/dev/${device})" $module
			set alias2module($id_alias) $module
		}
		close $fd

		# Load aliases
		set aliases_file [file join $modules_dir modules.alias]
		set fd [open $aliases_file]
		::tuapi::helper::foreach_line $fd " " {
			set alias [lindex $line 1]
			set module [lindex $line 2]

			set alias2module($alias) $module
			if {[string match {*\**} $alias]} {
				set alias2module_wildcards($alias) $module
			}
		}
		close $fd

		# Load dependencies
		set deps_file [file join $modules_dir modules.dep]
		set fd [open $deps_file]
		::tuapi::helper::foreach_line $fd ":" {
			set module [string trim [lindex $line 0]]
			set deps [split [string trim [join [lrange $line 1 end]]]]

			set module_basename [file rootname [file tail $module]]
			set module_basename_alt1 [string map [list "_" "-"] $module_basename]
			set module_basename_alt2 [string map [list "-" "_"] $module_basename]

			set alias2module($module_basename) $module
			set alias2module($module_basename_alt1) $module
			set alias2module($module_basename_alt2) $module

			if {[llength $deps] != 0} {
				set module2deps($module) $deps
			}
		}
		close $fd

		set ::tuapi::cache::alias2module [array get alias2module]
		set ::tuapi::cache::alias2module_wildcards [array get alias2module_wildcards]
		set ::tuapi::cache::module2deps [array get module2deps]
	} else {
		array set alias2module $::tuapi::cache::alias2module
		array set alias2module_wildcards $::tuapi::cache::alias2module_wildcards
		array set module2deps $::::tuapi::cache::module2deps
	}

	# Load modules
	foreach modules $args {
		foreach module $modules {
			# If the module is given as an absolute path, ignore the path
			# and process just as we would if the name were given alone
			# This may be wrong, but otherwise dependency matching would
			# be harder
			if {[string index $module 0] == "/" && [file exists $module]} {
				set module [file rootname [file tail]]
			}

			for {set try 0} {$try < 100} {incr try} {
				if {![info exists alias2module($module)]} {
					# If no exact match found, process wildcard entries
					set found_wildcard_match 0
					foreach alias [array name alias2module_wildcards] {
						if {[string match $alias $module]} {
							set module $alias2module_wildcards($alias)
................................................................................
			foreach module $load {
				if {[string match "/dev/*" $module]} {
					return -code error "Unable to lookup device node module for $module"
				}

				set module [file join $modules_dir $module]

				if {$options(call_insmod)} {
					::tuapi::syscall::insmod $module
				}

				lappend retval $module
			}
		}
	}

	return $retval
}

# Scan the various buses attached to the system and load the appropriate
# kernel modules
proc ::tuapi::scan_and_load_kernel_modules {{rescan_hardware 0}} {
	set modules [list]

	# Determine which modules are already loaded
	foreach module [glob -tails -nocomplain -directory /sys/module -type d *] {
		set alt_module1 [string map [list "_" "-"] $module]
		set alt_module2 [string map [list "-" "_"] $module]

		set loaded($module) 1
		set loaded($alt_module1) 1
		set loaded($alt_module2) 1
	}

	::tuapi::helper::recursive_glob /sys/devices modalias {
		set fd [open $filename r]
		::tuapi::helper::foreach_line $fd "\n" {
			foreach module [::tuapi::modprobe -dontload -- $line] {
				if {[lsearch -exact $modules $module] != -1} {
					continue
				}

				if {![file exists $module]} {
					continue
				}

				set rootname [file rootname [file tail $module]]
				if {[info exists loaded($rootname)]} {
					continue
				}

				lappend modules $module
			}
		}
		close $fd
	}

	set failed_to_load [list]
	set able_to_load [list]
	foreach module $modules {
		if {[catch {
			::tuapi::modprobe $module
		}]} {
			lappend failed_to_load $module
		} else {
			lappend able_to_load $module
		}
	}
................................................................................

	return [list -failed $failed_to_load -loaded $able_to_load]
}

# Create UNIX-like procs meant to be used interactively
proc ::tuapi::create_unix_commands {} {
	proc ::cat args {
		foreach file $args {
			if {[catch {