udev

udev is the device manager of linux. It is event-based and there usually is a nice command that is able to output events on the stdout as these occur. The following package is a wrapper around this command, supporting handlers that will be called whenever matching events will occur. Note that an updated version (under version control) of this can now be found within a project on bitbucket

namespace eval ::udev {
    variable UDEV
    if { ![info exists UDEV]} {
        array set UDEV {
            idgene        0
            methods_evt   {get}
            methods_udev  {handler}
            -monitor      "udevadm monitor --property"
        }
        variable version 0.1
    }
    namespace export monitor handler get
    namespace ensemble create
}


# ::udev::monitor -- Create monitoring context
#
#       Creates a monitoring context and return an identifier for the
#       monitoring.  The identifier returned is also a command that
#       can be used for further operations with this module.
#
# Arguments:
#        args        Dash-led options and values, only supported is -monitor
#
# Results:
#       A context, that also is a command
#
# Side Effects:
#       None.
proc ::udev::monitor { args } {
    variable UDEV

    set cx [namespace current]::udev:[incr UDEV(idGene)]
    interp alias {} $cx {} ::udev::Dispatch $cx

    upvar \#0 $cx CX
    array set OPTS $args
    foreach k [array names UDEV -*] {
        set CX($k) $UDEV($k)
        if { [info exists OPTS($k)] } {
            set CX($k) $OPTS($k)
        }
    }
    set CX(init) 0
    set CX(handlers) {}
    set CX(lines) {}
    set CX(fd) ""

    return $cx
}


# ::udev::handler -- Register a handler
#
#       Register a handler to be called whenever an event matching the
#       arguments occur.  The arguments should be a list of key
#       patterns and value patterns.  This pattern matcher is applied
#       onto the event and only events that match will triggered the
#       command registered as a handler.  The command will be called
#       with an additional argument, the identifier of the event.
#       This is an array, but also a command that can be used for
#       further operations on the event.  Event are shortlived, they
#       are removed automatically as soon as all relevant handlers
#       have been triggered.
#
# Arguments:
#        cx        Context, as returned by procedure abovea
#        cmd        Command to call on matching event.
#        args        Matcher description, empty will capture all events.
#
# Results:
#       None.
#
# Side Effects:
#       Will fork the -monitor command and arrange for reading,
#       understanding and filtering its output.
proc ::udev::handler { cx cmd args } {
    upvar \#0 $cx CX

    lappend CX(handlers) $cmd $args
    if { $CX(fd) eq "" } {
        # Create command pipe
        set monitor "|"
        append monitor $CX(-monitor)

        # Start the pipe and arrange to read all output
        if { [catch {open $monitor} fd] == 0 } {
            fconfigure $fd -buffering line -blocking off
            set CX(fd) $fd
            fileevent $CX(fd) readable [list [namespace current]::Read $cx]
        }
    }
}


# ::udev::get -- Get key from event
#
#       Get the key from an event, this is a convenience procedure.
#
# Arguments:
#        ev        Identifier of the event
#        key        Key to get
#
# Results:
#       Value of key or empty string if key does not exists.
#
# Side Effects:
#       None.
proc ::udev::get { ev key } {
    upvar \#0 $ev EVT
    if { [info exists EVT($key)] } {
        return $EVT($key)
    }
    return ""
}


# ::udev::Dispatch -- Command dispatcher
#
#       Dispatch command for object-like API.  The dispatcher is aware
#       of both types of objects/commands that are used within this
#       module.
#
# Arguments:
#        obj        Identifier of object
#        method        Method to dispatch
#        args        Arguments to method
#
# Results:
#       Will call the relevant procedure
#
# Side Effects:
#       Errors on unknown types or methods.
proc ::udev::Dispatch { obj method args } {
    variable UDEV
    # Guess type out of object identifier
    foreach {type id} [split [namespace tail $obj] :] break
    
    # Check that the method is allowed for that type.
    if { [info exists UDEV(methods_$type)] } {
        if {[lsearch -exact $UDEV(methods_$type) $method] < 0} {
            return -code error \
                "Bad method $method for a $type:\
                 must be one of [join $UDEV(methods_$type) ,]"
        }
    } else {
        return -code error "$type isn't a recognised object type"
    }

    # Dispatch
    if {[catch {eval [linsert $args 0 $method $obj]} msg]} {
        return -code error $msg
    }
    return $msg
}


# ::udev::Trigger -- Trigger relevant handlers
#
#       Trigger all handlers that match the event that has just been
#       captured.
#
# Arguments:
#        cx        Monitoring context
#        evt        Identifier of event
#
# Results:
#       Number of commands that were successfully triggered
#
# Side Effects:
#       Call external handlers!
proc ::udev::Trigger { cx evt } {
    upvar \#0 $cx CX
    upvar \#0 $evt EVT

    # Traverse all known handlers, looking for matching ones.
    set triggers 0
    foreach {cmd args} $CX(handlers) {
        # Count down matches based on the number of field patterns.
        set matches [expr {[llength $args]/2}]
        if { $matches > 0 } {
            # Match the key patterns against the value patterns. They
            # all have to match for us to trigger.
            foreach {k v} $args {
                set found 0
                foreach i [array names EVT] {
                    if { [string match $k $i] && [string match $v $EVT($i)] } {
                        set found 1
                    }
                }
                # We have a match (at least) account for it.
                if { $found } {
                    incr matches -1
                }
            }
        }

        # If we've managed to match all criterias, trigger the handler
        # registered with the identifier of the event as an additional
        # argument.
        if { $matches <= 0 } {
            if { [catch {eval [linsert $cmd end $evt]}] == 0 } {
                incr triggers
            }
        }
    }

    return $triggers
}


# ::udev::Read -- Read output from 'udevadm monitor'
#
#       Read output from udevadm monitor and create events once they
#       are isolated.  Trigger relevant handlers for those events.
#
# Arguments:
#        cx        Monitoring context
#
# Results:
#       None.
#
# Side Effects:
#       None.
proc ::udev::Read { cx } {
    variable UDEV
    upvar \#0 $cx CX

    set line [string trim [gets $CX(fd)]]
    if { ! $CX(init) } {
        # We are still reading the header, wait for the empty line and
        # once found, remember that we are now done with the header
        # and should continue further to reading events.
        if { $line eq "" } {
            set CX(init) 1
        }
    } else {
        # Events are separated by one or more empty lines.  We
        # accumulate all lines that we've found and once we read an
        # empty line, loop through the accumulated lines to form the
        # event and trigger.
        if { $line eq "" } {
            if { [llength $CX(lines)] > 0 } {
                # Create event
                set evt [namespace current]::evt:[incr UDEV(idGene)]
                interp alias {} $evt {} ::udev::Dispatch $evt
                upvar \#0 $evt EVT
                foreach l $CX(lines) {
                    foreach {k v} [split $l "="] break
                    set EVT([string trim $k]) [string trim $v]
                }
                set CX(lines) {}

                # Trigger relevant commands and cleanup
                Trigger $cx $evt

                interp alias {} $evt {}
                unset $evt
            }
        } else {
            # Make sure we ignore the first line that gives a general
            # summary of the event.  There might be better and more
            # flexible ways of doing this.
            set ignore 0
            foreach ptn [list {UDEV*\[[0-9]*} {KERNEL\[[0-9]*}] {
                if { [string match $ptn $line] } {
                    set ignore 1
                }
            }
            
            if { !$ignore } {
                lappend CX(lines) $line
            }
        }
    }
}


package provide udev $::udev::version

To exercise it and show it capabilities, you can try the following script. As soon as you insert an USB key in a port, it will print out the device for the USB key, and where it is mounted (most modern linux automatically mount keys on insertion). It will also print a message when you remove the key.

package require udev

proc ::findme { cx id count } {
    set dev ""
    foreach f [glob -nocomplain -directory /dev/disk/by-id *${id}*part*] {
        set dev [file normalize [file join /dev/disk/by-id [file readlink $f]]]
        break
    }

    if { $dev eq "" } {
        incr count -1
        if { $count > 0 } {
            after 1000 [list ::findme $cx $id $count]
        }
    } else {
        puts "Inserted disk available at: $dev, waiting for removal"
        set mounts [exec mount]
        foreach l [split $mounts "\n"] {
            if { [lindex $l 0] eq $dev } {
                puts "USB disk is mounted on [lindex $l 2]"
            }
        }

        $cx handler [list ::printme $cx] \
            ACTION remove ID_SERIAL_SHORT * DEVNAME $dev
    }
}


proc ::printme { cx e } {
    switch [$e get ACTION] {
        "add" {
            after 1000 [list ::findme $cx [$e get ID_SERIAL] 10]
        }
        "remove" {
            puts "[$e get DEVNAME] removed from USB port"
        }
    }
}


set cx [udev monitor]
$cx handler [list ::printme $cx] ACTION add ID_SERIAL_SHORT * SUBSYSTEM usb

vwait forever