Diff

Differences From Artifact [f69d9c9167]:

To Artifact [7cc91409f0]:


1
2
3
4

5
6
7
8
9
10
11
1
2
3
4
5
6
7
8
9
10
11
12




+







#! /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
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
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








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




+
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+




+
+
+
+
+
+
+
+







		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 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 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
			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]
		# 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
			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]]]]
		# 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 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
			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
			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)
385
386
387
388
389
390
391

392
393
394
395






























































396
397
398
399
400
401
402
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







+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







			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
			}
		}
	}
					::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 {