plugins/tcl/example.tcl

   1 # Example Tcl plugin.
   2 #
   3 # This example can be freely used for any purpose.
   4
   5 # Run it from the build directory like this:
   6 #
   7 #   ./nbdkit -f -v tcl ./plugins/tcl/example.tcl file=disk.img
   8 #
   9 # Or run it after installing nbdkit like this:
  10 #
  11 #   nbdkit -f -v tcl ./plugins/tcl/example.tcl file=disk.img
  12 #
  13 # The -f -v arguments are optional.  They cause the server to stay in
  14 # the foreground and print debugging, which is useful when testing.
  15 #
  16 # You can connect to the server using guestfish or qemu, eg:
  17 #
  18 #   guestfish --format=raw -a nbd://localhost
  19 #   ><fs> run
  20 #   ><fs> part-disk /dev/sda mbr
  21 #   ><fs> mkfs ext2 /dev/sda1
  22 #   ><fs> list-filesystems
  23 #   ><fs> mount /dev/sda1 /
  24 #   ><fs> [etc]
  25
  26 # This is called from: nbdkit tcl example.tcl --dump-plugin
  27 proc dump_plugin {} {
  28     puts "example_tcl=1"
  29 }
  30
  31 # We expect a file=... parameter pointing to the file to serve.
  32 proc config {key value} {
  33     global file
  34
  35     if { $key == "file" } {
  36         set file $value
  37     } else {
  38         error "unknown parameter $key=$value"
  39     }
  40 }
  41
  42 # Check the file parameter was passed.
  43 proc config_complete {} {
  44     global file
  45
  46     if { ![info exists file] } {
  47         error "file parameter missing"
  48     }
  49 }
  50
  51 # Open a new client connection.
  52 proc plugin_open {readonly} {
  53     global file
  54
  55     # Open the file.
  56     if { $readonly } {
  57         set flags "r"
  58     } else {
  59         set flags "r+"
  60     }
  61     set fh [open $file $flags]
  62
  63     # Stop Tcl from trying to convert to and from UTF-8.
  64     fconfigure $fh -translation binary
  65
  66     # We can return any Tcl object as the handle.  In this
  67     # plugin it's convenient to return the file handle.
  68     return $fh
  69 }
  70
  71 # Close a client connection.
  72 proc plugin_close {fh} {
  73     close $fh
  74 }
  75
  76 proc get_size {fh} {
  77     global file
  78
  79     return [file size $file]
  80 }
  81
  82 proc pread {fh count offset} {
  83     seek $fh $offset
  84     return [read $fh $count]
  85 }
  86
  87 proc pwrite {fh buf offset} {
  88     seek $fh $offset
  89     puts -nonewline $fh $buf
  90 }