01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

bind dcc n fileinfo tellfileinfo
proc tellfileinfo {hand idx text} {
    if {$text eq ""} {
        foreach f [file channels] {
            if {![string match file* $f]} { continue }
            catch {tellfileinfo $hand $idx $f}
        }
    } else {
        set f $text
        putdcc $idx "Filesock $f -> [file normalize [handle2file $f]]. Opened by \[[handle2opener $f]\]"
    }
}

if {![info exists ::opentrace]} {
    # add the 2 traces. one to 'open', one to 'close'.
    trace add execution open leave tracer_open
    trace add execution close leave tracer_close
    set ::opentrace 1
}

#procedure to lookup <socket> to <filename> (or commandname if piped)
# Usage: handle2file fileXXXX
# Example: "handle2file [open randomfile w]" should return "randomfile"
# (close the file afterwards :)
proc handle2file {handle} {
    if {![info exists ::openfiles($handle)]} {
        error "File handle not found"
    } else {
        return [lindex $::openfiles($handle) 0]
    }
}

#procedure to lookup <socket> to <procedure which initially called open>
proc handle2opener {handle} {
    if {![info exists ::openfiles($handle)]} {
        error "File handle not found"
    } else {
        return [lindex $::openfiles($handle) 1]
    }
}

# tracer_open "open <filename> ?mode?" 0/1 "file..." leave
proc tracer_open {cmdstr rescode resstr op} {
    # there was an error, file wasn't really opened
    if {$rescode} { return }
    # check if it was a filesocket
    if {[string match file* $resstr]} {
        # add handle with corresponding filename to array
        if {[catch {info level -1} caller]} { set caller -global- }
        set ::openfiles($resstr) [list [lindex [split $cmdstr] 1] $caller]
    }
}

# tracer_close "close <handle>" 0/1 "" leave
proc tracer_close {cmdstr rescode resstr op} {
    set handle [lindex [split $cmdstr] 1]
    # there was an error or I don't know about that handle
    if {$rescode || ![info exists ::openfiles($handle)]} { return }
    # remove handle from array
    unset ::openfiles($handle)
}