#!../tclsh
# -*- tcl -*-
# decode containing login records (linux, see 'man utmp').
# arg 1 is file to be read.

# ensure existence of blob extension

if {{} == [info command blob]} {
    puts "this [info nameofexecutable] does not contain the blob extension"
    puts "$argv0 is therefore rendered useless"
    return
}


if {$argc < 1} {
    puts "usage: $argv0 file"
    exit
}

# get file and read it into memory

set file    [lindex $argv 0]
set fhandle [open $file r]

[blob create utmp] set file $fhandle
close $fhandle

# -- preparation of output (types, procedures)
# the output is designed to be sourceable by tcl
# (to assemble login files after manipulation)
#
# readable login types
set logtype(0) unknown
set logtype(1) runlevel
set logtype(2) boottime
set logtype(3) new_time
set logtype(4) old_time
set logtype(5) init
set logtype(6) login
set logtype(7) user
set logtype(8) dead
# longest entry is 8 characters

proc sep {} {
    puts "sep     ----------------------------------------------------------------------------"
}

proc printhead {} {
    #    "record  runlevel      0            ~ ~~ 821528492 shutdown                  57802752"
    puts "header  type        pid  device name id logintime user     hostname         ip-addr"
    sep
}

proc printrec {arec} {
    # reformat and print ascii record
    global logtype

    set type    $logtype([lindex $arec 0])
    set pid     [lindex $arec 1]
    set line    [lindex $arec 2]
    set id      [lindex $arec 3]
    set time    [lindex $arec 4]
    set user    [lindex $arec 5]
    set host    [lindex $arec 6]
    set ip_addr [lindex $arec 7]

    regsub -all {[ 	]*} $line {} line
    regsub -all {[ 	]*} $user {} user
    regsub -all {[ 	]*} $host {} host

    if {{} == $line} {set line {?}}
    if {{} == $user} {set user {?}}
    if {{} == $host} {set host {?}}

    set res [format {%8s %6d %12s %2s %9d %8s %16s %d} $type $pid $line $id $time $user $host $ip_addr]
    puts "record  $res"
}


# split data into login records and unpack them.
#	see file utmp.fmt for full analyzation of a single record.

blob create rec
set format  sx2la12a2x2la8a16l	;# s x l a  a x l a a  l
set fmtsize 56			;# 2+2+4+12+2+2+4+8+16+4

puts "\nanalyze \"$file\" ([utmp size] bytes) ...\n"
sep
printhead
while {[utmp size] > 0} {
    rec  set    blob utmp 0 $fmtsize
    utmp remove           0 $fmtsize

    if {! [catch {set arec [rec unpack $format]} msg]} {
	printrec $arec
    } else {
	puts "partial record: $msg"
    }    
}
sep
printhead
puts ""

# done, destroy containers
rename rec  {}
rename utmp {}
