Discover Hosts on Local Network

As part of my work on the Context Manager I am interested in knowing who is present in the house. As a starter, I intend to base a first implementation on discovering the presence of mobile phones within the local home network. This is a "good" approximation since most individuals (down in ages!) now have a phone and most will turn on wifi within their home to benefit from "free" data traffic. The following code forms the basis of an initial implementation. It basically listen on the wlan interface of a computer placed within the network and will output the MAC address of the network entities present on the network, outputing a log line whenever a computer disappears from the network, i.e. whenever a person is present/absent.

It isn't perfect, requires that you are allowed to run tcpdump, i.e. that you have proper privileges and has only been tested on linux. It focuses on the MAC address since most typical routers won't reallocate the same IP address to a given device across time.

package require uobj

array set MACSPY {
    -interface   wlan1
    -lifetime    480
    buf          {}
    lastline     ""
    dt_fmt       "%d%m%y %H:%M:%S"
}

proc device { mac } {
    global MACSPY

    set dv [::uobj::find [namespace current] device \
                [list mac == [string tolower $mac]]]
    if { $dv eq "" } {
        set dv [::uobj::new [namespace current] device]
        upvar \#0 $dv DEVICE
        set DEVICE(mac) [string tolower $mac]
        set DEVICE(id) $dv
        set DEVICE(last) [clock seconds]
        puts "\[[clock format $DEVICE(last) -format $MACSPY(dt_fmt)]\] Discovered $DEVICE(mac)"
    } else {
        set DEVICE(last) [clock seconds]
    }
}

proc emit {} {
    global MACSPY

    set firstline [lindex $MACSPY(buf) 0]
    set hex "\[0-9a-fA-F\]\[0-9a-fA-F\]"
    if { [regexp "(${hex}:${hex}:${hex}:${hex}:${hex}:${hex}) > (${hex}:${hex}:${hex}:${hex}:${hex}:${hex}),\\s*(\\S*)," $firstline - snd rcv proto] } {
        switch -nocase -glob -- $proto {
            "ARP" -
            "IPv?" {
                foreach mac [list $snd $rcv] {
                    device $mac
                }
            }
            "802.3" {
                device $rcv
            }
        }
    }
}


proc check {} {
    global MACSPY

    set now [clock seconds]
    foreach dv [::uobj::allof [namespace current] device] {
        upvar \#0 $dv DEVICE
        if { [expr {$now - $DEVICE(last)}] > $MACSPY(-lifetime) } {
            puts "\[[clock format $now -format $MACSPY(dt_fmt)]\] Device $DEVICE(mac) silent for the last $MACSPY(-lifetime)\
                  seconds, removing"
            ::uobj::delete $dv
        }
    }

    after 1000 check
}

proc push { l } {
    global MACSPY

    set firstchar [string index $l 0]
    if { [string is space $firstchar] } {
        lappend MACSPY(buf) [string trim $l]
    } else {
        if { [llength $MACSPY(buf)] > 0 } {
            emit
            set MACSPY(buf) [list]
        } else {
            lappend MACSPY(buf) [string trim $l]
        }
    }
}

proc readline { fd } {
    global MACSPY

    if { ![fblocked $fd] && ![eof $fd] } {
        set lines [split [read $fd] \n]
        set len [llength $lines]
        set i 0
        foreach l $lines {
            incr i
            if { $i == $len } {
                set MACSPY(lastline) $l
            } elseif { $i == 1 } {
                append MACSPY(lastline) $l
                push $MACSPY(lastline)
                set MACSPY(lastline) ""
            } else {
                push $l
            }
        }
    }
}



set cmd "tcpdump -levvnnqti $MACSPY(-interface)"
if { [catch {open "|$cmd" RDWR} fd] } {
    puts "Cannot start tcpdump: $fd"
    exit
} else {
    fconfigure $fd -buffering line -blocking off  \
        -translation binary
    fileevent $fd readable [list ::readline $fd]
}

after 1000 check
vwait forever