1#!/usr/local/bin/tclsh8.2
2
3# Copyright (C) 2002 Daniel O'Connor.
4# All rights reserved.
5#
6# Redistribution and use in source and binary forms, with or without
7# modification, are permitted provided that the following conditions
8# are met:
9# 1. Redistributions of source code must retain the above copyright
10#    notice, this list of conditions and the following disclaimer.
11# 2. Redistributions in binary form must reproduce the above copyright
12#    notice, this list of conditions and the following disclaimer in the
13#    documentation and/or other materials provided with the distribution.
14# 3. Neither the name of the project nor the names of its contributors
15#    may be used to endorse or promote products derived from this software
16#    without specific prior written permission.
17#
18# THIS SOFTWARE IS PROVIDED BY THE PROJECT AND CONTRIBUTORS ``AS IS'' AND
19# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
20# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
21# ARE DISCLAIMED.  IN NO EVENT SHALL THE PROJECT OR CONTRIBUTORS BE LIABLE
22# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
24# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
25# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
26# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
27# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
28# SUCH DAMAGE.
29
30#
31# Usage
32#
33# Ktrace the process(es) you're interested in like so ->
34#
35# ktrace -ditcn -f ~/install.ktr make install
36#
37# Now run kdump over this file and pipe to parse-kdump.tcl
38# kdump -m1 -f ~/install.ktr | parse-kdump.tcl
39#
40
41proc main {} {
42    set fh stdin;
43    set state "CALL";
44    set interested "";
45    set cwd [pwd];
46    set namea "";
47
48    while {![eof $fh]} {
49	gets $fh line;
50
51	if {$line == ""} {
52	    continue;
53	}
54
55	if {[scan $line "%d %s %s %\[^\n\]" pid name type rest] != 4} {
56	    if {$state != "GIO"} {
57		puts stderr "Unable to parse '$line'";
58		exit 1;
59	    } else {
60		#puts stderr "Got IO";
61		continue;
62	    }
63	}
64
65	#puts stderr "Pid - $pid, Name - $name, Type - $type, Rest - $rest";
66
67	switch -- $type {
68	    "CALL" -
69	    "RET" -
70	    "GIO" -
71	    "NAMI" {
72	    }
73
74	    default {
75		puts stderr "Unknown type $type"
76		exit 1;
77	    }
78	}
79
80	#puts "State is $state";
81	switch -- $type {
82	    "CALL" {
83		set namea "";
84		if {$state != "RET" && $state != "CALL" && $state != "NAMI"} {
85		    puts stderr "Invalid state transition from $state to CALL";
86		    exit 1;
87		} else {
88		    set state $type;
89		}
90
91		set cargs "";
92		set res [scan $rest "%\[^(\](%\[^)\]" callname cargs];
93		if {$res != 1 && $res != 2} {
94		    puts stderr "Couldn't derive syscall name from $rest";
95		    exit 1;
96		}
97
98		if {$callname == "open"} {
99		    if {[scan $cargs "%\[^,\],%\[^,\],%s" fptr flags mode] != 3} {
100			puts stderr "Couldn't parse open args from $cargs";
101			exit 1;
102		    }
103
104		    #puts stderr "Open with $flags, mode $mode";
105		    set interested [list $callname $flags $mode];
106		} elseif {$callname == "chdir"} {
107		    set interested [list $callname];
108		} elseif {$callname == "rename"} {
109		    set interested [list $callname];
110		} elseif {$callname == "unlink"} {
111		    set interested [list $callname];
112		}
113	    }
114
115	    "RET" {
116		set namea "";
117		if {$state != "CALL" && $state != "GIO" && $state != "NAMI" && $state != "RET"} {
118		    puts "Invalid state transition from $state to RET";
119		    exit 1;
120		} else {
121		    set state $type;
122		}
123		set interested "";
124	    }
125
126	    "NAMI" {
127		if {$state != "CALL" && $state != "NAMI"} {
128		    puts "Invalid state transition from $state to NAMI";
129		    exit 1;
130		} else {
131		    set state $type;
132		}
133		if {$interested != ""} {
134		    if {[scan $rest "\"%\[^\"\]\"" fname] != 1} {
135			puts stderr "Unable to derive filename from $rest";
136			exit 1;
137		    }
138
139		    switch -- [lindex $interested 0] {
140			"open" {
141			    set flags [expr [lindex $interested 1]];
142			    set mode [expr [lindex $interested 2]];
143			    #puts stderr "Mode = $mode, Flags = $flags";
144			    if {[file pathtype $fname] == "relative"} {
145				set fname [file join $cwd $fname];
146			    }
147			    if {[expr $flags & 0x02] || [expr $flags & 0x200]} {
148				#puts "Got an open for writing on $fname";
149				#puts "$name $fname";
150				puts "+$fname";
151			    }
152			}
153
154			"rename" {
155			    if {$namea != ""} {
156				#puts "rename from $namea to $fname";
157				puts "-$namea";
158				puts "+$fname";
159			    } else {
160				set namea $fname;
161				#puts "namea = $namea";
162			    }
163			}
164
165			"chdir" {
166			    set cwd "$fname";
167			    #puts "Changed working directory to $cwd";
168			}
169
170			"unlink" {
171			    puts "-$fname";
172			}
173
174			default {
175			    puts "Got a [lindex $interested 0] $fname";
176			}
177		    }
178		}
179	    }
180
181	    "GIO" {
182		set namea "";
183		if {$state != "CALL" && $state != "GIO"} {
184		    puts "Invalid state transition from $state to GIO";
185		    exit 1;
186		} else {
187		    set state $type;
188		}
189	    }
190
191	    default {
192		puts stderr "WTF, Invalid state?"
193		exit 1;
194	    }
195	}
196    }
197}
198
199main;
200