06-25-2017, 14:04 +0200
AuthorPost
thommey  06-15-2008, 09:02   | [TCL] Trace open file handles (to get the filename from an open filesocket) Jabber
(Administrator)
Member since 03/2004
62 Posts
                                                                                                                              
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)
}

This post was edited 4 times, last on 09-26-2010, 02:14 by thommey
Advanced options for this topic:

Ignore this topic (Do not list this topic in the "unread topics" search. You are currently not ignoring this topic.)
Hide this topic (Hidden topics are not displayed in the topics list. This topic is currently not hidden.)
Go to forum

Unclassified NewsBoard 1.5.3-d | © 2003-4 by Yves Goergen