1
2
3
4
5
6
7
8
9
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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
# Example Tcl plugin.
#
# This example can be freely used for any purpose.
# Run it from the build directory like this:
#
# ./nbdkit -f -v tcl ./plugins/tcl/example.tcl file=disk.img
#
# Or run it after installing nbdkit like this:
#
# nbdkit -f -v tcl ./plugins/tcl/example.tcl file=disk.img
#
# The -f -v arguments are optional. They cause the server to stay in
# the foreground and print debugging, which is useful when testing.
#
# You can connect to the server using guestfish or qemu, eg:
#
# guestfish --format=raw -a nbd://localhost
# ><fs> run
# ><fs> part-disk /dev/sda mbr
# ><fs> mkfs ext2 /dev/sda1
# ><fs> list-filesystems
# ><fs> mount /dev/sda1 /
# ><fs> [etc]
# This is called from: nbdkit tcl example.tcl --dump-plugin
proc dump_plugin {} {
puts "example_tcl=1"
}
# We expect a file=... parameter pointing to the file to serve.
proc config {key value} {
global file
if { $key == "file" } {
set file $value
} else {
error "unknown parameter $key=$value"
}
}
# Check the file parameter was passed.
proc config_complete {} {
global file
if { ![info exists file] } {
error "file parameter missing"
}
}
# Open a new client connection.
proc plugin_open {readonly} {
global file
# Open the file.
if { $readonly } {
set flags "r"
} else {
set flags "r+"
}
set fh [open $file $flags]
# Stop Tcl from trying to convert to and from UTF-8.
fconfigure $fh -translation binary
# We can return any Tcl object as the handle. In this
# plugin it's convenient to return the file handle.
return $fh
}
# Close a client connection.
proc plugin_close {fh} {
close $fh
}
proc get_size {fh} {
global file
return [file size $file]
}
proc pread {fh count offset} {
seek $fh $offset
return [read $fh $count]
}
proc pwrite {fh buf offset} {
seek $fh $offset
puts -nonewline $fh $buf
}
|
