2 # Visualize nbdkit activity - read the README file first!
3 # Copyright (C) 2018 Red Hat Inc.
6 # Redistribution and use in source and binary forms, with or without
7 # modification, are permitted provided that the following conditions are
10 # * Redistributions of source code must retain the above copyright
11 # notice, this list of conditions and the following disclaimer.
13 # * Redistributions in binary form must reproduce the above copyright
14 # notice, this list of conditions and the following disclaimer in the
15 # documentation and/or other materials provided with the distribution.
17 # * Neither the name of Red Hat nor the names of its contributors may be
18 # used to endorse or promote products derived from this software without
19 # specific prior written permission.
21 # THIS SOFTWARE IS PROVIDED BY RED HAT AND CONTRIBUTORS ''AS IS'' AND
22 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
23 # THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
24 # PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL RED HAT OR
25 # CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
27 # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
28 # USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
29 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
30 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
31 # OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
36 # Create an nbdcanvas object.
38 # canvas: canvas object name which is created (eg. ".c")
39 # logfile: log file to monitor
40 # size: size in bytes of the underlying disk
41 # blocksize: size in bytes of the block corresponding to each pixel
42 # width: width of the canvas (height is determined from size & blocksize)
43 # scale: each pixel is scaled by this amount
45 # Returns an opaque handle which should be passed to nbdpoll.
46 proc nbdcanvas { canvas logfile size blocksize width scale } {
47 set height [expr {$size / $blocksize / $width}]
49 # Width and height of the canvas.
50 set w_scaled [expr {$width*$scale}]
51 set h_scaled [expr {$height*$scale}]
52 canvas $canvas -bg white -width $w_scaled -height $h_scaled
54 # Because Tk's canvas cannot scale images, we use a very
55 # inefficient double buffering here where we have $img which
56 # contains the raw data but is not displayed, and $dispimg which
57 # is the displayed image which is copied/zoomed from $img whenever
59 set img [image create photo -width $width -height $height]
60 $img put "white" -to 0 0 $width $height
61 set dispimg [image create photo -width $w_scaled -height $h_scaled]
62 # -borderwidth somehow counts towards the canvas area?! So we have
63 # to offset the image by 4, 4 here to make it fully visible.
64 $canvas create image 4 4 -anchor nw -image $dispimg
67 set fp [open $logfile "r"]
72 blocksize $blocksize \
82 # Return the computed height of the image in pixels.
83 proc nbdheight { h } {
84 return [dict get $h height]
87 # Blit $img to $dispimg, with scaling. If the optional img parameter
88 # is given, blit that image to $dispimg instead, else use the normal
89 # img stored in the handle.
90 proc update_dispimg { h { img - } } {
91 if { "$img" eq "-" } {
92 set img [dict get $h img]
94 set dispimg [dict get $h dispimg]
95 set scale [dict get $h scale]
96 $dispimg copy $img -zoom $scale $scale
100 # This flashes the pixels, but restores their previous value.
101 proc handle_read { h offset count } {
102 set blocksize [dict get $h blocksize]
103 set width [dict get $h width]
104 set height [dict get $h height]
105 set img [dict get $h img]
107 # We only write into a temporary image here.
108 set tmpimg [image create photo -width $width -height $height]
111 while { $count > 0 } {
112 set lba [expr {$offset/$blocksize}]
113 set x [expr {$lba % $width}]
114 set y [expr {$lba / $width}]
116 # Set the read pixel to black.
117 $tmpimg put "black" -to $x $y [expr {$x+1}] [expr {$y+1}]
119 incr offset $blocksize
120 incr count [expr {-$blocksize}]
123 # Update the display buffer with the temporary image.
124 update_dispimg $h $tmpimg
127 # Discard the temporary copy.
130 # We don't actually update the display image again. It will be
131 # restored next time something happens.
141 # Handle an operation.
144 # op: operation, "w"-rite, "t"-rim, "z"-ero
145 # offset, count: in bytes
146 proc handle_op { h op offset count } {
149 set blocksize [dict get $h blocksize]
150 set width [dict get $h width]
151 set img [dict get $h img]
153 # Choose a colour based on the operation.
154 set col $colours($op)
156 while { $count > 0 } {
157 set lba [expr {$offset/$blocksize}]
158 set x [expr {$lba % $width}]
159 set y [expr {$lba / $width}]
161 # Set the pixel at (x, y) to col.
162 $img put $col -to $x $y [expr {$x+1}] [expr {$y+1}]
164 incr offset $blocksize
165 incr count [expr {-$blocksize}]
170 # Handle a single line from the log file.
171 proc handle { h line } {
172 if { [ regexp {\mRead.*offset=(0x[[:xdigit:]]+).*count=(0x[[:xdigit:]]+)} $line -> offset count ] } {
173 handle_read $h $offset $count
174 } elseif { [ regexp {\mWrite.*offset=(0x[[:xdigit:]]+).*count=(0x[[:xdigit:]]+)} $line -> offset count ] } {
175 handle_op $h w $offset $count
176 } elseif { [ regexp {\mTrim.*offset=(0x[[:xdigit:]]+).*count=(0x[[:xdigit:]]+)} $line -> offset count ] } {
177 handle_op $h t $offset $count
178 } elseif { [ regexp {\mZero.*offset=(0x[[:xdigit:]]+).*count=(0x[[:xdigit:]]+)} $line -> offset count ] } {
179 handle_op $h z $offset $count
181 # else just ignore any lines we don't understand
184 # If nothing happens in nbdpoll for a few iterations then we update
185 # the displayed image. This is so that black read bars don't appear
186 # permanently if nothing else is happening.
189 # Poll the logfile and update the canvas.
190 # This has to be called every so often from the main program.
194 set fp [dict get $h fp]
196 # Read as much as we can from the log file.
197 set data [read -nonewline $fp]
199 set lines [split $data \n]
200 foreach line $lines {
204 # Nothing happening, did pollcount go to zero yet?
206 if { $pollcount == 0 } {