X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=cceb1915251cc477e50c8962f1c5af77337fcc0d;hp=f634cc8e2529233943c461d7328be4a784346b5c;hb=8fd7f255d611d2092a244c4a48c6b7b4529e98b1;hpb=ec02f0da1550e37acd95d615ff4fcf88569bcf2c diff --git a/src/generator.ml b/src/generator.ml index f634cc8..cceb191 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -35,6 +35,7 @@ #load "unix.cma";; #load "str.cma";; +open Unix open Printf type style = ret * args @@ -142,6 +143,7 @@ and argt = | DeviceList of string(* list of Device names (each cannot be NULL) *) | Bool of string (* boolean *) | Int of string (* int (smallish ints, signed, <= 31 bits) *) + | Int64 of string (* any 64 bit int *) (* These are treated as filenames (simple string parameters) in * the C API and bindings. But in the RPC protocol, we transfer * the actual file content up to or down from the daemon. @@ -345,13 +347,13 @@ and cmd = string list (* Generate a random UUID (used in tests). *) let uuidgen () = - let chan = Unix.open_process_in "uuidgen" in + let chan = open_process_in "uuidgen" in let uuid = input_line chan in - (match Unix.close_process_in chan with - | Unix.WEXITED 0 -> () - | Unix.WEXITED _ -> + (match close_process_in chan with + | WEXITED 0 -> () + | WEXITED _ -> failwith "uuidgen: process exited with non-zero status" - | Unix.WSIGNALED _ | Unix.WSTOPPED _ -> + | WSIGNALED _ | WSTOPPED _ -> failwith "uuidgen: process signalled or stopped by signal" ); uuid @@ -364,6 +366,7 @@ let test_all_args = [ StringList "strlist"; Bool "b"; Int "integer"; + Int64 "integer64"; FileIn "filein"; FileOut "fileout"; ] @@ -755,7 +758,8 @@ To construct the original version string: C<$major.$minor.$release$extra> I Don't use this call to test for availability -of features. Distro backports makes this unreliable."); +of features. Distro backports makes this unreliable. Use +C instead."); ("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"], [InitNone, Always, TestOutputTrue ( @@ -833,6 +837,32 @@ The default is disabled."); "\ Return the direct appliance mode flag."); + ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"], + [InitNone, Always, TestOutputTrue ( + [["set_recovery_proc"; "true"]; + ["get_recovery_proc"]])], + "enable or disable the recovery process", + "\ +If this is called with the parameter C then +C does not create a recovery process. The +purpose of the recovery process is to stop runaway qemu +processes in the case where the main program aborts abruptly. + +This only has any effect if called before C, +and the default is true. + +About the only time when you would want to disable this is +if the main process will fork itself into the background +(\"daemonize\" itself). In this case the recovery process +thinks that the main program has disappeared and so kills +qemu, which is not very helpful."); + + ("get_recovery_proc", (RBool "recoveryproc", []), -1, [], + [], + "get recovery process enabled flag", + "\ +Return the recovery process enabled flag."); + ] (* daemon_functions are any functions which cause some action @@ -842,7 +872,7 @@ Return the direct appliance mode flag."); let daemon_functions = [ ("mount", (RErr, [Device "device"; String "mountpoint"]), 1, [], [InitEmpty, Always, TestOutput ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; ["write_file"; "/new"; "new file contents"; "0"]; @@ -1386,7 +1416,7 @@ on the volume group C, with C megabytes."); ("mkfs", (RErr, [String "fstype"; Device "device"]), 42, [], [InitEmpty, Always, TestOutput ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; ["write_file"; "/new"; "new file contents"; "0"]; @@ -1423,7 +1453,8 @@ To create a single partition occupying the whole disk, you would pass C as a single element list, when the single element being the string C<,> (comma). -See also: C, C"); +See also: C, C, +C"); ("write_file", (RErr, [Pathname "path"; String "content"; Int "size"]), 44, [ProtocolLimitWarning], [InitBasicFS, Always, TestOutput ( @@ -1461,12 +1492,12 @@ use C."); ("umount", (RErr, [String "pathordevice"]), 45, [FishAlias "unmount"], [InitEmpty, Always, TestOutputListOfDevices ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; ["mounts"]], ["/dev/sda1"]); InitEmpty, Always, TestOutputList ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; ["umount"; "/"]; @@ -2006,7 +2037,7 @@ to find out what you can do."); ("lvremove", (RErr, [Device "device"]), 77, [], [InitEmpty, Always, TestOutputList ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["pvcreate"; "/dev/sda1"]; ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; @@ -2014,7 +2045,7 @@ to find out what you can do."); ["lvremove"; "/dev/VG/LV1"]; ["lvs"]], ["/dev/VG/LV2"]); InitEmpty, Always, TestOutputList ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["pvcreate"; "/dev/sda1"]; ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; @@ -2022,7 +2053,7 @@ to find out what you can do."); ["lvremove"; "/dev/VG"]; ["lvs"]], []); InitEmpty, Always, TestOutputList ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["pvcreate"; "/dev/sda1"]; ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; @@ -2039,7 +2070,7 @@ the VG name, C."); ("vgremove", (RErr, [String "vgname"]), 78, [], [InitEmpty, Always, TestOutputList ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["pvcreate"; "/dev/sda1"]; ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; @@ -2047,7 +2078,7 @@ the VG name, C."); ["vgremove"; "VG"]; ["lvs"]], []); InitEmpty, Always, TestOutputList ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["pvcreate"; "/dev/sda1"]; ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; @@ -2063,7 +2094,7 @@ group (if any)."); ("pvremove", (RErr, [Device "device"]), 79, [], [InitEmpty, Always, TestOutputListOfDevices ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["pvcreate"; "/dev/sda1"]; ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; @@ -2072,7 +2103,7 @@ group (if any)."); ["pvremove"; "/dev/sda1"]; ["lvs"]], []); InitEmpty, Always, TestOutputListOfDevices ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["pvcreate"; "/dev/sda1"]; ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; @@ -2081,7 +2112,7 @@ group (if any)."); ["pvremove"; "/dev/sda1"]; ["vgs"]], []); InitEmpty, Always, TestOutputListOfDevices ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["pvcreate"; "/dev/sda1"]; ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV1"; "VG"; "50"]; @@ -2358,7 +2389,7 @@ the human-readable, canonical hex dump of the file."); ("zerofree", (RErr, [Device "device"]), 97, [], [InitNone, Always, TestOutput ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkfs"; "ext3"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; ["write_file"; "/new"; "test file"; "0"]; @@ -2396,7 +2427,9 @@ This runs L option to modify just the single partition C (note: C counts from 1). For other parameters, see C. You should usually -pass C<0> for the cyls/heads/sectors parameters."); +pass C<0> for the cyls/heads/sectors parameters. + +See also: C"); ("sfdisk_l", (RString "partitions", [Device "device"]), 100, [], [], @@ -2404,7 +2437,9 @@ pass C<0> for the cyls/heads/sectors parameters."); "\ This displays the partition table on C, in the human-readable output of the L command. It is -not intended to be parsed."); +not intended to be parsed. + +See also: C"); ("sfdisk_kernel_geometry", (RString "partitions", [Device "device"]), 101, [], [], @@ -2456,7 +2491,7 @@ are activated or deactivated."); ("lvresize", (RErr, [Device "device"; Int "mbytes"]), 105, [], [InitNone, Always, TestOutput ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["pvcreate"; "/dev/sda1"]; ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV"; "VG"; "10"]; @@ -2549,11 +2584,11 @@ Sleep for C seconds."); ("ntfs_3g_probe", (RInt "status", [Bool "rw"; Device "device"]), 110, [], [InitNone, Always, TestOutputInt ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkfs"; "ntfs"; "/dev/sda1"]; ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 0); InitNone, Always, TestOutputInt ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkfs"; "ext2"; "/dev/sda1"]; ["ntfs_3g_probe"; "true"; "/dev/sda1"]], 12)], "probe NTFS volume", @@ -2831,7 +2866,7 @@ the command C."); ("mkswap", (RErr, [Device "device"]), 130, [], [InitEmpty, Always, TestRun ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkswap"; "/dev/sda1"]])], "create a swap partition", "\ @@ -2839,7 +2874,7 @@ Create a swap partition on C."); ("mkswap_L", (RErr, [String "label"; Device "device"]), 131, [], [InitEmpty, Always, TestRun ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkswap_L"; "hello"; "/dev/sda1"]])], "create a swap partition with a label", "\ @@ -2852,7 +2887,7 @@ a limitation of the kernel or swap tools."); ("mkswap_U", (RErr, [String "uuid"; Device "device"]), 132, [], (let uuid = uuidgen () in [InitEmpty, Always, TestRun ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkswap_U"; uuid; "/dev/sda1"]])]), "create a swap partition with an explicit UUID", "\ @@ -2996,7 +3031,8 @@ only (rounded to the nearest cylinder) and you don't need to specify the cyls, heads and sectors parameters which were rarely if ever used anyway. -See also C and the L manpage."); +See also: C, the L manpage +and C"); ("zfile", (RString "description", [String "meth"; Pathname "path"]), 140, [DeprecatedBy "file"], [], @@ -3343,7 +3379,7 @@ This command disables the libguestfs appliance swap on file."); ("swapon_label", (RErr, [String "label"]), 174, [], [InitEmpty, Always, TestRun ( - [["sfdiskM"; "/dev/sdb"; ","]; + [["part_disk"; "/dev/sdb"; "mbr"]; ["mkswap_L"; "swapit"; "/dev/sdb1"]; ["swapon_label"; "swapit"]; ["swapoff_label"; "swapit"]; @@ -3508,7 +3544,7 @@ and C"); ("mkfs_b", (RErr, [String "fstype"; Int "blocksize"; Device "device"]), 187, [], [InitEmpty, Always, TestOutput ( - [["sfdiskM"; "/dev/sda"; ","]; + [["part_disk"; "/dev/sda"; "mbr"]; ["mkfs_b"; "ext2"; "4096"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]; ["write_file"; "/new"; "new file contents"; "0"]; @@ -3703,6 +3739,428 @@ This function does not handle drive names, backslashes etc. See also C."); + ("vfs_type", (RString "fstype", [Device "device"]), 198, [], + [InitBasicFS, Always, TestOutput ( + [["vfs_type"; "/dev/sda1"]], "ext2")], + "get the Linux VFS type corresponding to a mounted device", + "\ +This command gets the block device type corresponding to +a mounted device called C. + +Usually the result is the name of the Linux VFS module that +is used to mount this device (probably determined automatically +if you used the C call)."); + + ("truncate", (RErr, [Pathname "path"]), 199, [], + [InitBasicFS, Always, TestOutputStruct ( + [["write_file"; "/test"; "some stuff so size is not zero"; "0"]; + ["truncate"; "/test"]; + ["stat"; "/test"]], [CompareWithInt ("size", 0)])], + "truncate a file to zero size", + "\ +This command truncates C to a zero-length file. The +file must exist already."); + + ("truncate_size", (RErr, [Pathname "path"; Int64 "size"]), 200, [], + [InitBasicFS, Always, TestOutputStruct ( + [["touch"; "/test"]; + ["truncate_size"; "/test"; "1000"]; + ["stat"; "/test"]], [CompareWithInt ("size", 1000)])], + "truncate a file to a particular size", + "\ +This command truncates C to size C bytes. The file +must exist already. If the file is smaller than C then +the file is extended to the required size with null bytes."); + + ("utimens", (RErr, [Pathname "path"; Int64 "atsecs"; Int64 "atnsecs"; Int64 "mtsecs"; Int64 "mtnsecs"]), 201, [], + [InitBasicFS, Always, TestOutputStruct ( + [["touch"; "/test"]; + ["utimens"; "/test"; "12345"; "67890"; "9876"; "5432"]; + ["stat"; "/test"]], [CompareWithInt ("mtime", 9876)])], + "set timestamp of a file with nanosecond precision", + "\ +This command sets the timestamps of a file with nanosecond +precision. + +C are the last access time (atime) in secs and +nanoseconds from the epoch. + +C are the last modification time (mtime) in +secs and nanoseconds from the epoch. + +If the C<*nsecs> field contains the special value C<-1> then +the corresponding timestamp is set to the current time. (The +C<*secs> field is ignored in this case). + +If the C<*nsecs> field contains the special value C<-2> then +the corresponding timestamp is left unchanged. (The +C<*secs> field is ignored in this case)."); + + ("mkdir_mode", (RErr, [Pathname "path"; Int "mode"]), 202, [], + [InitBasicFS, Always, TestOutputStruct ( + [["mkdir_mode"; "/test"; "0o111"]; + ["stat"; "/test"]], [CompareWithInt ("mode", 0o40111)])], + "create a directory with a particular mode", + "\ +This command creates a directory, setting the initial permissions +of the directory to C. See also C."); + + ("lchown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 203, [], + [], (* XXX *) + "change file owner and group", + "\ +Change the file owner to C and group to C. +This is like C but if C is a symlink then +the link itself is changed, not the target. + +Only numeric uid and gid are supported. If you want to use +names, you will need to locate and parse the password file +yourself (Augeas support makes this relatively easy)."); + + ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [], + [], (* XXX *) + "lstat on multiple files", + "\ +This call allows you to perform the C operation +on multiple files, where all files are in the directory C. +C is the list of files from this directory. + +On return you get a list of stat structs, with a one-to-one +correspondence to the C list. If any name did not exist +or could not be lstat'd, then the C field of that structure +is set to C<-1>. + +This call is intended for programs that want to efficiently +list a directory contents without making many round-trips. +See also C for a similarly efficient call +for getting extended attributes. Very long directory listings +might cause the protocol message size to be exceeded, causing +this call to fail. The caller must split up such requests +into smaller groups of names."); + + ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [], + [], (* XXX *) + "lgetxattr on multiple files", + "\ +This call allows you to get the extended attributes +of multiple files, where all files are in the directory C. +C is the list of files from this directory. + +On return you get a flat list of xattr structs which must be +interpreted sequentially. The first xattr struct always has a zero-length +C. C in this struct is zero-length +to indicate there was an error doing C for this +file, I is a C string which is a decimal number +(the number of following attributes for this file, which could +be C<\"0\">). Then after the first xattr struct are the +zero or more attributes for the first named file. +This repeats for the second and subsequent files. + +This call is intended for programs that want to efficiently +list a directory contents without making many round-trips. +See also C for a similarly efficient call +for getting standard stats. Very long directory listings +might cause the protocol message size to be exceeded, causing +this call to fail. The caller must split up such requests +into smaller groups of names."); + + ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [], + [], (* XXX *) + "readlink on multiple files", + "\ +This call allows you to do a C operation +on multiple files, where all files are in the directory C. +C is the list of files from this directory. + +On return you get a list of strings, with a one-to-one +correspondence to the C list. Each string is the +value of the symbol link. + +If the C operation fails on any name, then +the corresponding result string is the empty string C<\"\">. +However the whole operation is completed even if there +were C errors, and so you can call this +function with names where you don't know if they are +symbolic links already (albeit slightly less efficient). + +This call is intended for programs that want to efficiently +list a directory contents without making many round-trips. +Very long directory listings might cause the protocol +message size to be exceeded, causing +this call to fail. The caller must split up such requests +into smaller groups of names."); + + ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning], + [InitISOFS, Always, TestOutputBuffer ( + [["pread"; "/known-4"; "1"; "3"]], "\n"); + InitISOFS, Always, TestOutputBuffer ( + [["pread"; "/empty"; "0"; "100"]], "")], + "read part of a file", + "\ +This command lets you read part of a file. It reads C +bytes of the file, starting at C, from file C. + +This may read fewer bytes than requested. For further details +see the L system call."); + + ("part_init", (RErr, [Device "device"; String "parttype"]), 208, [], + [InitEmpty, Always, TestRun ( + [["part_init"; "/dev/sda"; "gpt"]])], + "create an empty partition table", + "\ +This creates an empty partition table on C of one of the +partition types listed below. Usually C should be +either C or C (for large disks). + +Initially there are no partitions. Following this, you should +call C for each partition required. + +Possible values for C are: + +=over 4 + +=item B | B + +Intel EFI / GPT partition table. + +This is recommended for >= 2 TB partitions that will be accessed +from Linux and Intel-based Mac OS X. It also has limited backwards +compatibility with the C format. + +=item B | B + +The standard PC \"Master Boot Record\" (MBR) format used +by MS-DOS and Windows. This partition type will B work +for device sizes up to 2 TB. For large disks we recommend +using C. + +=back + +Other partition table types that may work but are not +supported include: + +=over 4 + +=item B + +AIX disk labels. + +=item B | B + +Amiga \"Rigid Disk Block\" format. + +=item B + +BSD disk labels. + +=item B + +DASD, used on IBM mainframes. + +=item B + +MIPS/SGI volumes. + +=item B + +Old Mac partition format. Modern Macs use C. + +=item B + +NEC PC-98 format, common in Japan apparently. + +=item B + +Sun disk labels. + +=back"); + + ("part_add", (RErr, [Device "device"; String "prlogex"; Int64 "startsect"; Int64 "endsect"]), 209, [], + [InitEmpty, Always, TestRun ( + [["part_init"; "/dev/sda"; "mbr"]; + ["part_add"; "/dev/sda"; "primary"; "1"; "-1"]]); + InitEmpty, Always, TestRun ( + [["part_init"; "/dev/sda"; "gpt"]; + ["part_add"; "/dev/sda"; "primary"; "34"; "127"]; + ["part_add"; "/dev/sda"; "primary"; "128"; "-34"]]); + InitEmpty, Always, TestRun ( + [["part_init"; "/dev/sda"; "mbr"]; + ["part_add"; "/dev/sda"; "primary"; "32"; "127"]; + ["part_add"; "/dev/sda"; "primary"; "128"; "255"]; + ["part_add"; "/dev/sda"; "primary"; "256"; "511"]; + ["part_add"; "/dev/sda"; "primary"; "512"; "-1"]])], + "add a partition to the device", + "\ +This command adds a partition to C. If there is no partition +table on the device, call C first. + +The C parameter is the type of partition. Normally you +should pass C

or C here, but MBR partition tables also +support C (or C) and C (or C) partition +types. + +C and C are the start and end of the partition +in I. C may be negative, which means it counts +backwards from the end of the disk (C<-1> is the last sector). + +Creating a partition which covers the whole disk is not so easy. +Use C to do that."); + + ("part_disk", (RErr, [Device "device"; String "parttype"]), 210, [DangerWillRobinson], + [InitEmpty, Always, TestRun ( + [["part_disk"; "/dev/sda"; "mbr"]]); + InitEmpty, Always, TestRun ( + [["part_disk"; "/dev/sda"; "gpt"]])], + "partition whole disk with a single primary partition", + "\ +This command is simply a combination of C +followed by C to create a single primary partition +covering the whole disk. + +C is the partition table type, usually C or C, +but other possible values are described in C."); + + ("part_set_bootable", (RErr, [Device "device"; Int "partnum"; Bool "bootable"]), 211, [], + [InitEmpty, Always, TestRun ( + [["part_disk"; "/dev/sda"; "mbr"]; + ["part_set_bootable"; "/dev/sda"; "1"; "true"]])], + "make a partition bootable", + "\ +This sets the bootable flag on partition numbered C on +device C. Note that partitions are numbered from 1. + +The bootable flag is used by some PC BIOSes to determine which +partition to boot from. It is by no means universally recognized, +and in any case if your operating system installed a boot +sector on the device itself, then that takes precedence."); + + ("part_set_name", (RErr, [Device "device"; Int "partnum"; String "name"]), 212, [], + [InitEmpty, Always, TestRun ( + [["part_disk"; "/dev/sda"; "gpt"]; + ["part_set_name"; "/dev/sda"; "1"; "thepartname"]])], + "set partition name", + "\ +This sets the partition name on partition numbered C on +device C. Note that partitions are numbered from 1. + +The partition name can only be set on certain types of partition +table. This works on C but not on C partitions."); + + ("part_list", (RStructList ("partitions", "partition"), [Device "device"]), 213, [], + [], (* XXX Add a regression test for this. *) + "list partitions on a device", + "\ +This command parses the partition table on C and +returns the list of partitions found. + +The fields in the returned structure are: + +=over 4 + +=item B + +Partition number, counting from 1. + +=item B + +Start of the partition I. To get sectors you have to +divide by the device's sector size, see C. + +=item B + +End of the partition in bytes. + +=item B + +Size of the partition in bytes. + +=back"); + + ("part_get_parttype", (RString "parttype", [Device "device"]), 214, [], + [InitEmpty, Always, TestOutput ( + [["part_disk"; "/dev/sda"; "gpt"]; + ["part_get_parttype"; "/dev/sda"]], "gpt")], + "get the partition table type", + "\ +This command examines the partition table on C and +returns the partition table type (format) being used. + +Common return values include: C (a DOS/Windows style MBR +partition table), C (a GPT/EFI-style partition table). Other +values are possible, although unusual. See C +for a full list."); + + ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [], + [InitBasicFS, Always, TestOutputBuffer ( + [["fill"; "0x63"; "10"; "/test"]; + ["read_file"; "/test"]], "cccccccccc")], + "fill a file with octets", + "\ +This command creates a new file called C. The initial +content of the file is C octets of C, where C +must be a number in the range C<[0..255]>. + +To fill a file with zero bytes (sparsely), it is +much more efficient to use C."); + + ("available", (RErr, [StringList "groups"]), 216, [], + [], + "test availability of some parts of the API", + "\ +This command is used to check the availability of some +groups of libguestfs functions which not all builds of +libguestfs will be able to provide. + +The precise libguestfs function groups that may be checked by this +command are listed in L. + +The argument C is a list of API group names, eg: +C<[\"inotify\", \"part\"]> would check for the availability of +the C functions and C +(partition editing) functions. + +The command returns no error if I requested groups are available. + +It returns an error if one or more of the requested +groups is unavailable. + +If an unknown group name is included in the +list of C then an error is always returned. + +I + +=over 4 + +=item * + +You must call C before calling this function. +The reason is because we don't know what function groups are +supported by the appliance/daemon until it is running and can +be queried. + +=item * + +If a group of functions is available, this does not necessarily +mean that they will work. You still have to check for errors +when calling individual API functions even if they are +available. + +=item * + +It is usually the job of distro packagers to build +complete functionality into the libguestfs appliance. +Upstream libguestfs, if built from source with all +requirements satisfied, will support everything. + +=item * + +This call was added in version C<1.0.80>. In previous +versions of libguestfs all you could do would be to speculatively +execute a command to find out if the daemon implemented it. +See also C. + +=back"); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -3871,6 +4329,14 @@ let structs = [ "in_cookie", FUInt32; "in_name", FString; ]; + + (* Partition table entry. *) + "partition", [ + "part_num", FInt32; + "part_start", FBytes; + "part_end", FBytes; + "part_size", FBytes; + ]; ] (* end of structs *) (* Ugh, Java has to be different .. @@ -3887,6 +4353,7 @@ let java_structs = [ "version", "Version"; "xattr", "XAttr"; "inotify_event", "INotifyEvent"; + "partition", "Partition"; ] (* What structs are actually returned. *) @@ -3903,7 +4370,7 @@ type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList * == there are functions returning both RStruct (_, structname) * and RStructList (_, structname) *) -let rstructs_used = +let rstructs_used_by functions = (* ||| is a "logical OR" for rstructs_used_t *) let (|||) a b = match a, b with @@ -3932,27 +4399,18 @@ let rstructs_used = | RStruct (_, structname) -> update structname RStructOnly | RStructList (_, structname) -> update structname RStructListOnly | _ -> () - ) all_functions; + ) functions; (* return key->values as a list of (key,value) *) Hashtbl.fold (fun key value xs -> (key, value) :: xs) h [] -(* debug: -let () = - List.iter ( - function - | sn, RStructOnly -> printf "%s RStructOnly\n" sn - | sn, RStructListOnly -> printf "%s RStructListOnly\n" sn - | sn, RStructAndList -> printf "%s RStructAndList\n" sn - ) rstructs_used -*) - (* Used for testing language bindings. *) type callt = | CallString of string | CallOptString of string option | CallStringList of string list | CallInt of int + | CallInt64 of int64 | CallBool of bool (* Used to memoize the result of pod2text. *) @@ -4090,7 +4548,7 @@ let mapi f xs = let name_of_argt = function | Pathname n | Device n | Dev_or_Path n | String n | OptString n - | StringList n | DeviceList n | Bool n | Int n + | StringList n | DeviceList n | Bool n | Int n | Int64 n | FileIn n | FileOut n -> n let java_name_of_struct typ = @@ -4298,7 +4756,7 @@ let check_functions () = ) all_functions (* 'pr' prints to the current output file. *) -let chan = ref stdout +let chan = ref Pervasives.stdout let pr fs = ksprintf (output_string !chan) fs (* Generate a header block in a number of standard styles. *) @@ -4506,11 +4964,13 @@ and generate_xdr () = pr "struct %s_args {\n" name; List.iter ( function - | Pathname n | Device n | Dev_or_Path n | String n -> pr " string %s<>;\n" n + | Pathname n | Device n | Dev_or_Path n | String n -> + pr " string %s<>;\n" n | OptString n -> pr " str *%s;\n" n | StringList n | DeviceList n -> pr " str %s<>;\n" n | Bool n -> pr " bool %s;\n" n | Int n -> pr " int %s;\n" n + | Int64 n -> pr " hyper %s;\n" n | FileIn _ | FileOut _ -> () ) args; pr "};\n\n" @@ -4699,14 +5159,17 @@ and generate_client_actions () = pr "\ #include #include +#include +#include #include \"guestfs.h\" +#include \"guestfs-internal.h\" #include \"guestfs-internal-actions.h\" #include \"guestfs_protocol.h\" #define error guestfs_error //#define perrorf guestfs_perrorf -//#define safe_malloc guestfs_safe_malloc +#define safe_malloc guestfs_safe_malloc #define safe_realloc guestfs_safe_realloc //#define safe_strdup guestfs_safe_strdup #define safe_memdup guestfs_safe_memdup @@ -4801,6 +5264,8 @@ check_state (guestfs_h *g, const char *caller) pr " fputs (%s ? \" true\" : \" false\", stdout);\n" n | Int n -> (* int *) pr " printf (\" %%d\", %s);\n" n + | Int64 n -> + pr " printf (\" %%\" PRIi64, %s);\n" n ) (snd style); pr " putchar ('\\n');\n"; pr " }\n"; @@ -4890,6 +5355,8 @@ check_state (guestfs_h *g, const char *caller) pr " args.%s = %s;\n" n n | Int n -> pr " args.%s = %s;\n" n n + | Int64 n -> + pr " args.%s = %s;\n" n n | FileIn _ | FileOut _ -> () ) args; pr " serial = guestfs___send (g, GUESTFS_PROC_%s,\n" @@ -4991,8 +5458,20 @@ check_state (guestfs_h *g, const char *caller) pr " /* caller will free this */\n"; pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n | RBufferOut n -> - pr " *size_r = ret.%s.%s_len;\n" n n; - pr " return ret.%s.%s_val; /* caller will free */\n" n n + pr " /* RBufferOut is tricky: If the buffer is zero-length, then\n"; + pr " * _val might be NULL here. To make the API saner for\n"; + pr " * callers, we turn this case into a unique pointer (using\n"; + pr " * malloc(1)).\n"; + pr " */\n"; + pr " if (ret.%s.%s_len > 0) {\n" n n; + pr " *size_r = ret.%s.%s_len;\n" n n; + pr " return ret.%s.%s_val; /* caller will free */\n" n n; + pr " } else {\n"; + pr " free (ret.%s.%s_val);\n" n n; + pr " char *p = safe_malloc (g, 1);\n"; + pr " *size_r = ret.%s.%s_len;\n" n n; + pr " return p;\n"; + pr " }\n"; ); pr "}\n\n" @@ -5075,7 +5554,7 @@ and generate_daemon_actions () = | RStruct (_, typ) -> pr " guestfs_int_%s *r;\n" typ; "NULL" | RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL" | RBufferOut _ -> - pr " size_t size;\n"; + pr " size_t size = 1;\n"; pr " char *r;\n"; "NULL" in @@ -5092,6 +5571,7 @@ and generate_daemon_actions () = | StringList n | DeviceList n -> pr " char **%s;\n" n | Bool n -> pr " int %s;\n" n | Int n -> pr " int %s;\n" n + | Int64 n -> pr " int64_t %s;\n" n | FileIn _ | FileOut _ -> () ) args ); @@ -5143,6 +5623,7 @@ and generate_daemon_actions () = pr " }\n"; | Bool n -> pr " %s = args.%s;\n" n n | Int n -> pr " %s = args.%s;\n" n n + | Int64 n -> pr " %s = args.%s;\n" n n | FileIn _ | FileOut _ -> () ) args; pr "\n" @@ -5166,10 +5647,24 @@ and generate_daemon_actions () = generate_c_call_args (fst style, args'); pr ";\n"; - pr " if (r == %s)\n" error_code; - pr " /* do_%s has already called reply_with_error */\n" name; - pr " goto done;\n"; - pr "\n"; + (match fst style with + | RErr | RInt _ | RInt64 _ | RBool _ + | RConstString _ | RConstOptString _ + | RString _ | RStringList _ | RHashtable _ + | RStruct (_, _) | RStructList (_, _) -> + pr " if (r == %s)\n" error_code; + pr " /* do_%s has already called reply_with_error */\n" name; + pr " goto done;\n"; + pr "\n" + | RBufferOut _ -> + pr " /* size == 0 && r == NULL could be a non-error case (just\n"; + pr " * an ordinary zero-length buffer), so be careful ...\n"; + pr " */\n"; + pr " if (size == 1 && r == %s)\n" error_code; + pr " /* do_%s has already called reply_with_error */\n" name; + pr " goto done;\n"; + pr "\n" + ); (* If there are any FileOut parameters, then the impl must * send its own reply. @@ -5452,6 +5947,7 @@ and generate_tests () = #include #include \"guestfs.h\" +#include \"guestfs-internal.h\" static guestfs_h *g; static int suppress_error = 0; @@ -5538,7 +6034,7 @@ int main (int argc, char *argv[]) g = guestfs_create (); if (g == NULL) { printf (\"guestfs_create FAILED\\n\"); - exit (1); + exit (EXIT_FAILURE); } guestfs_set_error_handler (g, print_error, NULL); @@ -5549,94 +6045,94 @@ int main (int argc, char *argv[]) fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); if (fd == -1) { perror (filename); - exit (1); + exit (EXIT_FAILURE); } if (lseek (fd, %d, SEEK_SET) == -1) { perror (\"lseek\"); close (fd); unlink (filename); - exit (1); + exit (EXIT_FAILURE); } if (write (fd, &c, 1) == -1) { perror (\"write\"); close (fd); unlink (filename); - exit (1); + exit (EXIT_FAILURE); } if (close (fd) == -1) { perror (filename); unlink (filename); - exit (1); + exit (EXIT_FAILURE); } if (guestfs_add_drive (g, filename) == -1) { printf (\"guestfs_add_drive %%s FAILED\\n\", filename); - exit (1); + exit (EXIT_FAILURE); } filename = \"test2.img\"; fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); if (fd == -1) { perror (filename); - exit (1); + exit (EXIT_FAILURE); } if (lseek (fd, %d, SEEK_SET) == -1) { perror (\"lseek\"); close (fd); unlink (filename); - exit (1); + exit (EXIT_FAILURE); } if (write (fd, &c, 1) == -1) { perror (\"write\"); close (fd); unlink (filename); - exit (1); + exit (EXIT_FAILURE); } if (close (fd) == -1) { perror (filename); unlink (filename); - exit (1); + exit (EXIT_FAILURE); } if (guestfs_add_drive (g, filename) == -1) { printf (\"guestfs_add_drive %%s FAILED\\n\", filename); - exit (1); + exit (EXIT_FAILURE); } filename = \"test3.img\"; fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666); if (fd == -1) { perror (filename); - exit (1); + exit (EXIT_FAILURE); } if (lseek (fd, %d, SEEK_SET) == -1) { perror (\"lseek\"); close (fd); unlink (filename); - exit (1); + exit (EXIT_FAILURE); } if (write (fd, &c, 1) == -1) { perror (\"write\"); close (fd); unlink (filename); - exit (1); + exit (EXIT_FAILURE); } if (close (fd) == -1) { perror (filename); unlink (filename); - exit (1); + exit (EXIT_FAILURE); } if (guestfs_add_drive (g, filename) == -1) { printf (\"guestfs_add_drive %%s FAILED\\n\", filename); - exit (1); + exit (EXIT_FAILURE); } if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) { printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\"); - exit (1); + exit (EXIT_FAILURE); } if (guestfs_launch (g) == -1) { printf (\"guestfs_launch FAILED\\n\"); - exit (1); + exit (EXIT_FAILURE); } /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */ @@ -5668,11 +6164,11 @@ int main (int argc, char *argv[]) pr " if (n_failed > 0) {\n"; pr " printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n"; - pr " exit (1);\n"; + pr " exit (EXIT_FAILURE);\n"; pr " }\n"; pr "\n"; - pr " exit (0);\n"; + pr " exit (EXIT_SUCCESS);\n"; pr "}\n" and generate_one_test name i (init, prereq, test) = @@ -5687,9 +6183,9 @@ static int %s_skip (void) if (str) return strstr (str, \"%s\") == NULL; str = getenv (\"SKIP_%s\"); - if (str && strcmp (str, \"1\") == 0) return 1; + if (str && STREQ (str, \"1\")) return 1; str = getenv (\"SKIP_TEST_%s\"); - if (str && strcmp (str, \"1\") == 0) return 1; + if (str && STREQ (str, \"1\")) return 1; return 0; } @@ -5760,14 +6256,14 @@ and generate_one_test_body name i test_name init test = [["blockdev_setrw"; "/dev/sda"]; ["umount_all"]; ["lvm_remove_all"]; - ["sfdiskM"; "/dev/sda"; ","]] + ["part_disk"; "/dev/sda"; "mbr"]] | InitBasicFS -> pr " /* InitBasicFS for %s: create ext2 on /dev/sda1 */\n" test_name; List.iter (generate_test_command_call test_name) [["blockdev_setrw"; "/dev/sda"]; ["umount_all"]; ["lvm_remove_all"]; - ["sfdiskM"; "/dev/sda"; ","]; + ["part_disk"; "/dev/sda"; "mbr"]; ["mkfs"; "ext2"; "/dev/sda1"]; ["mount"; "/dev/sda1"; "/"]] | InitBasicFSonLVM -> @@ -5777,7 +6273,7 @@ and generate_one_test_body name i test_name init test = [["blockdev_setrw"; "/dev/sda"]; ["umount_all"]; ["lvm_remove_all"]; - ["sfdiskM"; "/dev/sda"; ","]; + ["part_disk"; "/dev/sda"; "mbr"]; ["pvcreate"; "/dev/sda1"]; ["vgcreate"; "VG"; "/dev/sda1"]; ["lvcreate"; "LV"; "VG"; "8"]; @@ -5810,7 +6306,7 @@ and generate_one_test_body name i test_name init test = pr " const char *expected = \"%s\";\n" (c_quote expected); let seq, last = get_seq_last seq in let test () = - pr " if (strcmp (r, expected) != 0) {\n"; + pr " if (STRNEQ (r, expected)) {\n"; pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name; pr " return -1;\n"; pr " }\n" @@ -5830,7 +6326,7 @@ and generate_one_test_body name i test_name init test = pr " }\n"; pr " {\n"; pr " const char *expected = \"%s\";\n" (c_quote str); - pr " if (strcmp (r[%d], expected) != 0) {\n" i; + pr " if (STRNEQ (r[%d], expected)) {\n" i; pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i; pr " return -1;\n"; pr " }\n"; @@ -5859,7 +6355,7 @@ and generate_one_test_body name i test_name init test = pr " {\n"; pr " const char *expected = \"%s\";\n" (c_quote str); pr " r[%d][5] = 's';\n" i; - pr " if (strcmp (r[%d], expected) != 0) {\n" i; + pr " if (STRNEQ (r[%d], expected)) {\n" i; pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r[%d]);\n" test_name i; pr " return -1;\n"; pr " }\n"; @@ -5955,7 +6451,7 @@ and generate_one_test_body name i test_name init test = pr " fprintf (stderr, \"%s: returned size of buffer wrong, expected %d but got %%zu\\n\", size);\n" test_name len; pr " return -1;\n"; pr " }\n"; - pr " if (strncmp (r, expected, size) != 0) {\n"; + pr " if (STRNEQLEN (r, expected, size)) {\n"; pr " fprintf (stderr, \"%s: expected \\\"%%s\\\" but got \\\"%%s\\\"\\n\", expected, r);\n" test_name; pr " return -1;\n"; pr " }\n" @@ -5983,7 +6479,7 @@ and generate_one_test_body name i test_name init test = pr " return -1;\n"; pr " }\n" | CompareWithString (field, expected) -> - pr " if (strcmp (r->%s, \"%s\") != 0) {\n" field expected; + pr " if (STRNEQ (r->%s, \"%s\")) {\n" field expected; pr " fprintf (stderr, \"%s: %s was \"%%s\", expected \"%s\"\\n\",\n" test_name field expected; pr " r->%s);\n" field; @@ -5997,7 +6493,7 @@ and generate_one_test_body name i test_name init test = pr " return -1;\n"; pr " }\n" | CompareFieldsStrEq (field1, field2) -> - pr " if (strcmp (r->%s, r->%s) != 0) {\n" field1 field2; + pr " if (STRNEQ (r->%s, r->%s)) {\n" field1 field2; pr " fprintf (stderr, \"%s: %s (\"%%s\") <> %s (\"%%s\")\\n\",\n" test_name field1 field2; pr " r->%s, r->%s);\n" field1 field2; @@ -6045,6 +6541,7 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = | OptString n, arg -> pr " const char *%s = \"%s\";\n" n (c_quote arg); | Int _, _ + | Int64 _, _ | Bool _, _ | FileIn _, _ | FileOut _, _ -> () | StringList n, arg | DeviceList n, arg -> @@ -6103,6 +6600,12 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd = with Failure "int_of_string" -> failwithf "%s: expecting an int, but got '%s'" test_name arg in pr ", %d" i + | Int64 _, arg -> + let i = + try Int64.of_string arg + with Failure "int_of_string" -> + failwithf "%s: expecting an int64, but got '%s'" test_name arg in + pr ", %Ld" i | Bool _, arg -> let b = bool_of_string arg in pr ", %d" (if b then 1 else 0) ) (List.combine (snd style) args); @@ -6202,8 +6705,8 @@ and generate_fish_cmds () = match snd style with | [] -> name2 | args -> - sprintf "%s <%s>" - name2 (String.concat "> <" (List.map name_of_argt args)) in + sprintf "%s %s" + name2 (String.concat " " (List.map name_of_argt args)) in let warnings = if List.mem ProtocolLimitWarning flags then @@ -6232,15 +6735,17 @@ and generate_fish_cmds () = else "" in pr " if ("; - pr "strcasecmp (cmd, \"%s\") == 0" name; + pr "STRCASEEQ (cmd, \"%s\")" name; if name <> name2 then - pr " || strcasecmp (cmd, \"%s\") == 0" name2; + pr " || STRCASEEQ (cmd, \"%s\")" name2; if name <> alias then - pr " || strcasecmp (cmd, \"%s\") == 0" alias; + pr " || STRCASEEQ (cmd, \"%s\")" alias; pr ")\n"; pr " pod2text (\"%s\", _(\"%s\"), %S);\n" name2 shortdesc - (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias); + ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^ + "=head1 DESCRIPTION\n\n" ^ + longdesc ^ warnings ^ describe_alias); pr " else\n" ) all_functions; pr " display_builtin_command (cmd);\n"; @@ -6279,17 +6784,17 @@ and generate_fish_cmds () = | name, FString -> pr " printf (\"%%s%s: %%s\\n\", indent, %s->%s);\n" name typ name | name, FUUID -> - pr " printf (\"%s: \");\n" name; + pr " printf (\"%%s%s: \", indent);\n" name; pr " for (i = 0; i < 32; ++i)\n"; - pr " printf (\"%%s%%c\", indent, %s->%s[i]);\n" typ name; + pr " printf (\"%%c\", %s->%s[i]);\n" typ name; pr " printf (\"\\n\");\n" | name, FBuffer -> pr " printf (\"%%s%s: \", indent);\n" name; pr " for (i = 0; i < %s->%s_len; ++i)\n" typ name; pr " if (c_isprint (%s->%s[i]))\n" typ name; - pr " printf (\"%%s%%c\", indent, %s->%s[i]);\n" typ name; + pr " printf (\"%%c\", %s->%s[i]);\n" typ name; pr " else\n"; - pr " printf (\"%%s\\\\x%%02x\", indent, %s->%s[i]);\n" typ name; + pr " printf (\"\\\\x%%02x\", %s->%s[i]);\n" typ name; pr " printf (\"\\n\");\n" | name, (FUInt64|FBytes) -> pr " printf (\"%%s%s: %%\" PRIu64 \"\\n\", indent, %s->%s);\n" @@ -6322,19 +6827,19 @@ and generate_fish_cmds () = (* generate the function for typ *) emit_print_list_function typ | typ, _ -> () (* empty *) - ) rstructs_used; + ) (rstructs_used_by all_functions); (* Emit a print_TYPE function definition only if that function is used. *) List.iter ( function - | typ, RStructOnly -> + | typ, (RStructOnly | RStructAndList) -> pr "static void print_%s (struct guestfs_%s *%s)\n" typ typ typ; pr "{\n"; pr " print_%s_indent (%s, \"\");\n" typ typ; pr "}\n"; pr "\n"; | typ, _ -> () (* empty *) - ) rstructs_used; + ) (rstructs_used_by all_functions); (* run_ actions *) List.iter ( @@ -6367,6 +6872,7 @@ and generate_fish_cmds () = | StringList n | DeviceList n -> pr " char **%s;\n" n | Bool n -> pr " int %s;\n" n | Int n -> pr " int %s;\n" n + | Int64 n -> pr " int64_t %s;\n" n ) (snd style); (* Check and convert parameters. *) @@ -6382,19 +6888,19 @@ and generate_fish_cmds () = function | Device name | String name -> - pr " %s = argv[%d];\n" name i + pr " %s = argv[%d];\n" name i | Pathname name | Dev_or_Path name -> - pr " %s = resolve_win_path (argv[%d]);\n" name i; - pr " if (%s == NULL) return -1;\n" name + pr " %s = resolve_win_path (argv[%d]);\n" name i; + pr " if (%s == NULL) return -1;\n" name | OptString name -> - pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n" + pr " %s = STRNEQ (argv[%d], \"\") ? argv[%d] : NULL;\n" name i i | FileIn name -> - pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdin\";\n" + pr " %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdin\";\n" name i i | FileOut name -> - pr " %s = strcmp (argv[%d], \"-\") != 0 ? argv[%d] : \"/dev/stdout\";\n" + pr " %s = STRNEQ (argv[%d], \"-\") ? argv[%d] : \"/dev/stdout\";\n" name i i | StringList name | DeviceList name -> pr " %s = parse_string_list (argv[%d]);\n" name i; @@ -6403,6 +6909,8 @@ and generate_fish_cmds () = pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i | Int name -> pr " %s = atoi (argv[%d]);\n" name i + | Int64 name -> + pr " %s = atoll (argv[%d]);\n" name i ) (snd style); (* Call C API function. *) @@ -6417,7 +6925,7 @@ and generate_fish_cmds () = function | Device name | String name | OptString name | FileIn name | FileOut name | Bool name - | Int name -> () + | Int name | Int64 name -> () | Pathname name | Dev_or_Path name -> pr " free (%s);\n" name | StringList name | DeviceList name -> @@ -6491,11 +6999,11 @@ and generate_fish_cmds () = try find_map (function FishAlias n -> Some n | _ -> None) flags with Not_found -> name in pr " if ("; - pr "strcasecmp (cmd, \"%s\") == 0" name; + pr "STRCASEEQ (cmd, \"%s\")" name; if name <> name2 then - pr " || strcasecmp (cmd, \"%s\") == 0" name2; + pr " || STRCASEEQ (cmd, \"%s\")" name2; if name <> alias then - pr " || strcasecmp (cmd, \"%s\") == 0" alias; + pr " || STRCASEEQ (cmd, \"%s\")" alias; pr ")\n"; pr " return run_%s (cmd, argc, argv);\n" name; pr " else\n"; @@ -6571,7 +7079,7 @@ generator (const char *text, int state) while ((name = commands[index]) != NULL) { index++; - if (strncasecmp (name, text, len) == 0) + if (STRCASEEQLEN (name, text, len)) return strdup (name); } @@ -6636,6 +7144,7 @@ and generate_fish_actions_pod () = | StringList n | DeviceList n -> pr " '%s ...'" n | Bool _ -> pr " true|false" | Int n -> pr " %s" n + | Int64 n -> pr " %s" n | FileIn n | FileOut n -> pr " (%s|-)" n ) (snd style); pr "\n"; @@ -6708,6 +7217,7 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true) pr "char *const *%s" n | Bool n -> next (); pr "int %s" n | Int n -> next (); pr "int %s" n + | Int64 n -> next (); pr "int64_t %s" n | FileIn n | FileOut n -> if not in_daemon then (next (); pr "const char *%s" n) @@ -6760,12 +7270,21 @@ type t exception Error of string (** This exception is raised when there is an error. *) +exception Handle_closed of string +(** This exception is raised if you use a {!Guestfs.t} handle + after calling {!close} on it. The string is the name of + the function. *) + val create : unit -> t +(** Create a {!Guestfs.t} handle. *) val close : t -> unit -(** Handles are closed by the garbage collector when they become - unreferenced, but callers can also call this in order to - provide predictable cleanup. *) +(** Close the {!Guestfs.t} handle and free up all resources used + by it immediately. + + Handles are closed by the garbage collector when they become + unreferenced, but callers can call this in order to provide + predictable cleanup. *) "; generate_ocaml_structure_decls (); @@ -6776,7 +7295,7 @@ val close : t -> unit generate_ocaml_prototype name style; pr "(** %s *)\n" shortdesc; pr "\n" - ) all_functions + ) all_functions_sorted (* Generate the OCaml bindings implementation. *) and generate_ocaml_ml () = @@ -6784,12 +7303,17 @@ and generate_ocaml_ml () = pr "\ type t + exception Error of string +exception Handle_closed of string + external create : unit -> t = \"ocaml_guestfs_create\" external close : t -> unit = \"ocaml_guestfs_close\" +(* Give the exceptions names, so they can be raised from the C code. *) let () = - Callback.register_exception \"ocaml_guestfs_error\" (Error \"\") + Callback.register_exception \"ocaml_guestfs_error\" (Error \"\"); + Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\") "; @@ -6799,7 +7323,7 @@ let () = List.iter ( fun (name, style, _, _, _, shortdesc, _) -> generate_ocaml_prototype ~is_external:true name style; - ) all_functions + ) all_functions_sorted (* Generate the OCaml bindings C implementation. *) and generate_ocaml_c () = @@ -6930,11 +7454,17 @@ copy_table (char * const * argv) (* generate the function for typ *) emit_ocaml_copy_list_function typ | typ, _ -> () (* empty *) - ) rstructs_used; + ) (rstructs_used_by all_functions); (* The wrappers. *) List.iter ( fun (name, style, _, _, _, _, _) -> + pr "/* Automatically generated wrapper for function\n"; + pr " * "; + generate_ocaml_prototype name style; + pr " */\n"; + pr "\n"; + let params = "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in @@ -6944,6 +7474,7 @@ copy_table (char * const * argv) pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n"; pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params); List.iter (pr ", value %s") (List.tl params); pr ");\n"; + pr "\n"; pr "CAMLprim value\n"; pr "ocaml_guestfs_%s (value %s" name (List.hd params); @@ -6969,7 +7500,7 @@ copy_table (char * const * argv) pr " guestfs_h *g = Guestfs_val (gv);\n"; pr " if (g == NULL)\n"; - pr " caml_failwith (\"%s: used handle after closing it\");\n" name; + pr " ocaml_guestfs_raise_closed (\"%s\");\n" name; pr "\n"; List.iter ( @@ -6990,6 +7521,8 @@ copy_table (char * const * argv) pr " int %s = Bool_val (%sv);\n" n n | Int n -> pr " int %s = Int_val (%sv);\n" n n + | Int64 n -> + pr " int64_t %s = Int64_val (%sv);\n" n n ) (snd style); let error_code = match fst style with @@ -7028,7 +7561,8 @@ copy_table (char * const * argv) function | StringList n | DeviceList n -> pr " ocaml_guestfs_free_strings (%s);\n" n; - | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _ + | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ + | Bool _ | Int _ | Int64 _ | FileIn _ | FileOut _ -> () ) (snd style); @@ -7090,7 +7624,7 @@ copy_table (char * const * argv) pr "}\n"; pr "\n" ) - ) all_functions + ) all_functions_sorted and generate_ocaml_structure_decls () = List.iter ( @@ -7120,6 +7654,7 @@ and generate_ocaml_prototype ?(is_external = false) name style = | StringList _ | DeviceList _ -> pr "string array -> " | Bool _ -> pr "bool -> " | Int _ -> pr "int -> " + | Int64 _ -> pr "int64 -> " ) (snd style); (match fst style with | RErr -> pr "unit" (* all errors are turned into exceptions *) @@ -7271,12 +7806,14 @@ DESTROY (g) | StringList n | DeviceList n -> pr " char **%s;\n" n | Bool n -> pr " int %s;\n" n | Int n -> pr " int %s;\n" n + | Int64 n -> pr " int64_t %s;\n" n ) (snd style); let do_cleanups () = List.iter ( function - | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _ + | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ + | Bool _ | Int _ | Int64 _ | FileIn _ | FileOut _ -> () | StringList n | DeviceList n -> pr " free (%s);\n" n ) (snd style) @@ -7648,7 +8185,7 @@ and generate_perl_prototype name style = comma := true; match arg with | Pathname n | Device n | Dev_or_Path n | String n - | OptString n | Bool n | Int n | FileIn n | FileOut n -> + | OptString n | Bool n | Int n | Int64 n | FileIn n | FileOut n -> pr "$%s" n | StringList n | DeviceList n -> pr "\\@%s" n @@ -7876,7 +8413,7 @@ py_guestfs_close (PyObject *self, PyObject *args) (* generate the function for typ *) emit_put_list_function typ | typ, _ -> () (* empty *) - ) rstructs_used; + ) (rstructs_used_by all_functions); (* Python wrapper functions. *) List.iter ( @@ -7915,6 +8452,7 @@ py_guestfs_close (PyObject *self, PyObject *args) pr " char **%s;\n" n | Bool n -> pr " int %s;\n" n | Int n -> pr " int %s;\n" n + | Int64 n -> pr " long long %s;\n" n ) (snd style); pr "\n"; @@ -7928,6 +8466,9 @@ py_guestfs_close (PyObject *self, PyObject *args) | StringList _ | DeviceList _ -> pr "O" | Bool _ -> pr "i" (* XXX Python has booleans? *) | Int _ -> pr "i" + | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to + * emulate C's int/long/long long in Python? + *) ) (snd style); pr ":guestfs_%s\",\n" name; pr " &py_g"; @@ -7938,6 +8479,7 @@ py_guestfs_close (PyObject *self, PyObject *args) | StringList n | DeviceList n -> pr ", &py_%s" n | Bool n -> pr ", &%s" n | Int n -> pr ", &%s" n + | Int64 n -> pr ", &%s" n ) (snd style); pr "))\n"; @@ -7947,7 +8489,7 @@ py_guestfs_close (PyObject *self, PyObject *args) List.iter ( function | Pathname _ | Device _ | Dev_or_Path _ | String _ - | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> () + | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> () | StringList n | DeviceList n -> pr " %s = get_string_list (py_%s);\n" n n; pr " if (!%s) return NULL;\n" n @@ -7962,7 +8504,7 @@ py_guestfs_close (PyObject *self, PyObject *args) List.iter ( function | Pathname _ | Device _ | Dev_or_Path _ | String _ - | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> () + | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> () | StringList n | DeviceList n -> pr " free (%s);\n" n ) (snd style); @@ -8168,7 +8710,7 @@ and pod2text ~width name longdesc = fprintf chan "=head1 %s\n\n%s\n" name longdesc; close_out chan; let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in - let chan = Unix.open_process_in cmd in + let chan = open_process_in cmd in let lines = ref [] in let rec loop i = let line = input_line chan in @@ -8180,12 +8722,12 @@ and pod2text ~width name longdesc = loop (i+1) ) in let lines = try loop 1 with End_of_file -> List.rev !lines in - Unix.unlink filename; - (match Unix.close_process_in chan with - | Unix.WEXITED 0 -> () - | Unix.WEXITED i -> + unlink filename; + (match close_process_in chan with + | WEXITED 0 -> () + | WEXITED i -> failwithf "pod2text: process exited with non-zero status (%d)" i - | Unix.WSIGNALED i | Unix.WSTOPPED i -> + | WSIGNALED i | WSTOPPED i -> failwithf "pod2text: process signalled or stopped by signal %d" i ); Hashtbl.add pod2text_memo key lines; @@ -8292,6 +8834,8 @@ static VALUE ruby_guestfs_close (VALUE gv) pr " int %s = RTEST (%sv);\n" n n | Int n -> pr " int %s = NUM2INT (%sv);\n" n n + | Int64 n -> + pr " long long %s = NUM2LL (%sv);\n" n n ) (snd style); pr "\n"; @@ -8319,7 +8863,7 @@ static VALUE ruby_guestfs_close (VALUE gv) List.iter ( function | Pathname _ | Device _ | Dev_or_Path _ | String _ - | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> () + | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ | Int64 _ -> () | StringList n | DeviceList n -> pr " free (%s);\n" n ) (snd style); @@ -8642,6 +9186,8 @@ and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false) pr "boolean %s" n | Int n -> pr "int %s" n + | Int64 n -> + pr "long %s" n ) (snd style); pr ")\n"; @@ -8761,6 +9307,8 @@ Java_com_redhat_et_libguestfs_GuestFS__1close pr ", jboolean j%s" n | Int n -> pr ", jint j%s" n + | Int64 n -> + pr ", jlong j%s" n ) (snd style); pr ")\n"; pr "{\n"; @@ -8814,6 +9362,8 @@ Java_com_redhat_et_libguestfs_GuestFS__1close | Bool n | Int n -> pr " int %s;\n" n + | Int64 n -> + pr " int64_t %s;\n" n ) (snd style); let needs_i = @@ -8855,7 +9405,8 @@ Java_com_redhat_et_libguestfs_GuestFS__1close pr " }\n"; pr " %s[%s_len] = NULL;\n" n n; | Bool n - | Int n -> + | Int n + | Int64 n -> pr " %s = j%s;\n" n n ) (snd style); @@ -8884,7 +9435,8 @@ Java_com_redhat_et_libguestfs_GuestFS__1close pr " }\n"; pr " free (%s);\n" n | Bool n - | Int n -> () + | Int n + | Int64 n -> () ) (snd style); (* Check for errors. *) @@ -9072,6 +9624,12 @@ module Guestfs ( pr " ) where + +-- Unfortunately some symbols duplicate ones already present +-- in Prelude. We don't know which, so we hard-code a list +-- here. +import Prelude hiding (truncate) + import Foreign import Foreign.C import Foreign.C.Types @@ -9146,7 +9704,7 @@ last_error h = do | Pathname n | Device n | Dev_or_Path n | String n -> pr "withCString %s $ \\%s -> " n n | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n | StringList n | DeviceList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n - | Bool _ | Int _ -> () + | Bool _ | Int _ | Int64 _ -> () ) (snd style); (* Convert integer arguments. *) let args = @@ -9154,6 +9712,7 @@ last_error h = do function | Bool n -> sprintf "(fromBool %s)" n | Int n -> sprintf "(fromIntegral %s)" n + | Int64 n -> sprintf "(fromIntegral %s)" n | FileIn n | FileOut n | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n -> n ) (snd style) in @@ -9210,6 +9769,7 @@ and generate_haskell_prototype ~handle ?(hs = false) style = | StringList _ | DeviceList _ -> if hs then pr "[String]" else pr "Ptr CString" | Bool _ -> pr "%s" bool | Int _ -> pr "%s" int + | Int64 _ -> pr "%s" int | FileIn _ -> pr "%s" string | FileOut _ -> pr "%s" string ); @@ -9246,6 +9806,7 @@ and generate_bindtests () = #include #include \"guestfs.h\" +#include \"guestfs-internal.h\" #include \"guestfs-internal-actions.h\" #include \"guestfs_protocol.h\" @@ -9290,6 +9851,7 @@ print_strings (char *const *argv) | StringList n | DeviceList n -> pr " print_strings (%s);\n" n | Bool n -> pr " printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n | Int n -> pr " printf (\"%%d\\n\", %s);\n" n + | Int64 n -> pr " printf (\"%%\" PRIi64 \"\\n\", %s);\n" n ) (snd style); pr " /* Java changes stdout line buffering so we need this: */\n"; pr " fflush (stdout);\n"; @@ -9316,7 +9878,7 @@ print_strings (char *const *argv) pr " sscanf (val, \"%%\" SCNi64, &r);\n"; pr " return r;\n" | RBool _ -> - pr " return strcmp (val, \"true\") == 0;\n" + pr " return STREQ (val, \"true\");\n" | RConstString _ | RConstOptString _ -> (* Can't return the input string here. Return a static @@ -9405,6 +9967,8 @@ let () = "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]" | CallInt i when i >= 0 -> string_of_int i | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")" + | CallInt64 i when i >= 0L -> Int64.to_string i ^ "L" + | CallInt64 i (* when i < 0L *) -> "(" ^ Int64.to_string i ^ "L)" | CallBool b -> string_of_bool b ) args ) @@ -9438,6 +10002,7 @@ my $g = Sys::Guestfs->new (); | CallStringList xs -> "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]" | CallInt i -> string_of_int i + | CallInt64 i -> Int64.to_string i | CallBool b -> if b then "1" else "0" ) args ) @@ -9468,6 +10033,7 @@ g = guestfs.GuestFS () | CallStringList xs -> "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]" | CallInt i -> string_of_int i + | CallInt64 i -> Int64.to_string i | CallBool b -> if b then "1" else "0" ) args ) @@ -9498,6 +10064,7 @@ g = Guestfs::create() | CallStringList xs -> "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]" | CallInt i -> string_of_int i + | CallInt64 i -> Int64.to_string i | CallBool b -> string_of_bool b ) args ) @@ -9533,6 +10100,7 @@ public class Bindtests { "new String[]{" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}" | CallInt i -> string_of_int i + | CallInt64 i -> Int64.to_string i | CallBool b -> string_of_bool b ) args ) @@ -9575,6 +10143,8 @@ main = do "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]" | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")" | CallInt i -> string_of_int i + | CallInt64 i when i < 0L -> "(" ^ Int64.to_string i ^ ")" + | CallInt64 i -> Int64.to_string i | CallBool true -> "True" | CallBool false -> "False" ) args @@ -9593,43 +10163,43 @@ main = do and generate_lang_bindtests call = call "test0" [CallString "abc"; CallOptString (Some "def"); CallStringList []; CallBool false; - CallInt 0; CallString "123"; CallString "456"]; + CallInt 0; CallInt64 0L; CallString "123"; CallString "456"]; call "test0" [CallString "abc"; CallOptString None; CallStringList []; CallBool false; - CallInt 0; CallString "123"; CallString "456"]; + CallInt 0; CallInt64 0L; CallString "123"; CallString "456"]; call "test0" [CallString ""; CallOptString (Some "def"); CallStringList []; CallBool false; - CallInt 0; CallString "123"; CallString "456"]; + CallInt 0; CallInt64 0L; CallString "123"; CallString "456"]; call "test0" [CallString ""; CallOptString (Some ""); CallStringList []; CallBool false; - CallInt 0; CallString "123"; CallString "456"]; + CallInt 0; CallInt64 0L; CallString "123"; CallString "456"]; call "test0" [CallString "abc"; CallOptString (Some "def"); CallStringList ["1"]; CallBool false; - CallInt 0; CallString "123"; CallString "456"]; + CallInt 0; CallInt64 0L; CallString "123"; CallString "456"]; call "test0" [CallString "abc"; CallOptString (Some "def"); CallStringList ["1"; "2"]; CallBool false; - CallInt 0; CallString "123"; CallString "456"]; + CallInt 0; CallInt64 0L; CallString "123"; CallString "456"]; call "test0" [CallString "abc"; CallOptString (Some "def"); CallStringList ["1"]; CallBool true; - CallInt 0; CallString "123"; CallString "456"]; + CallInt 0; CallInt64 0L; CallString "123"; CallString "456"]; call "test0" [CallString "abc"; CallOptString (Some "def"); CallStringList ["1"]; CallBool false; - CallInt (-1); CallString "123"; CallString "456"]; + CallInt (-1); CallInt64 (-1L); CallString "123"; CallString "456"]; call "test0" [CallString "abc"; CallOptString (Some "def"); CallStringList ["1"]; CallBool false; - CallInt (-2); CallString "123"; CallString "456"]; + CallInt (-2); CallInt64 (-2L); CallString "123"; CallString "456"]; call "test0" [CallString "abc"; CallOptString (Some "def"); CallStringList ["1"]; CallBool false; - CallInt 1; CallString "123"; CallString "456"]; + CallInt 1; CallInt64 1L; CallString "123"; CallString "456"]; call "test0" [CallString "abc"; CallOptString (Some "def"); CallStringList ["1"]; CallBool false; - CallInt 2; CallString "123"; CallString "456"]; + CallInt 2; CallInt64 2L; CallString "123"; CallString "456"]; call "test0" [CallString "abc"; CallOptString (Some "def"); CallStringList ["1"]; CallBool false; - CallInt 4095; CallString "123"; CallString "456"]; + CallInt 4095; CallInt64 4095L; CallString "123"; CallString "456"]; call "test0" [CallString "abc"; CallOptString (Some "def"); CallStringList ["1"]; CallBool false; - CallInt 0; CallString ""; CallString ""] + CallInt 0; CallInt64 0L; CallString ""; CallString ""] (* XXX Add here tests of the return and error functions. *) @@ -9651,33 +10221,54 @@ let output_to filename = chan := open_out filename_new; let close () = close_out !chan; - chan := stdout; + chan := Pervasives.stdout; (* Is the new file different from the current file? *) if Sys.file_exists filename && files_equal filename filename_new then - Unix.unlink filename_new (* same, so skip it *) + unlink filename_new (* same, so skip it *) else ( (* different, overwrite old one *) - (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ()); - Unix.rename filename_new filename; - Unix.chmod filename 0o444; + (try chmod filename 0o644 with Unix_error _ -> ()); + rename filename_new filename; + chmod filename 0o444; printf "written %s\n%!" filename; ) in close +let perror msg = function + | Unix_error (err, _, _) -> + eprintf "%s: %s\n" msg (error_message err) + | exn -> + eprintf "%s: %s\n" msg (Printexc.to_string exn) + (* Main program. *) let () = - check_functions (); - - if not (Sys.file_exists "HACKING") then ( - eprintf "\ + let lock_fd = + try openfile "HACKING" [O_RDWR] 0 + with + | Unix_error (ENOENT, _, _) -> + eprintf "\ You are probably running this from the wrong directory. Run it from the top source directory using the command src/generator.ml "; - exit 1 - ); + exit 1 + | exn -> + perror "open: HACKING" exn; + exit 1 in + + (* Acquire a lock so parallel builds won't try to run the generator + * twice at the same time. Subsequent builds will wait for the first + * one to finish. Note the lock is released implicitly when the + * program exits. + *) + (try lockf lock_fd F_LOCK 1 + with exn -> + perror "lock: HACKING" exn; + exit 1); + + check_functions (); let close = output_to "src/guestfs_protocol.x" in generate_xdr ();