# # # patch "Monotone/AutomateStdio.pm" # from [2c5747294e7d73b21fdaa7519b20ba8d53a51d80] # to [8f4af0bfdf1c72f65bc932b5b23df5e85c4170f4] # # patch "Monotone/AutomateStdio.pod" # from [d54fc235262827b1cf8a06dc569ca97cfae02458] # to [f02a38ab6c1e084ff0f2e1277abed9a8c5e17740] # # patch "mtn-tester" # from [c18eaecac2098aafe8f70660d778cdd0bfba71ba] # to [b83629177793a803fc08529166e89f1612956bbd] # ============================================================ --- Monotone/AutomateStdio.pm 2c5747294e7d73b21fdaa7519b20ba8d53a51d80 +++ Monotone/AutomateStdio.pm 8f4af0bfdf1c72f65bc932b5b23df5e85c4170f4 @@ -67,10 +67,16 @@ use Symbol qw(gensym); # Constants used to represent the different types of capability Monotone may or # may not provide depending upon its version. -use constant MTN_IGNORE_SUSPEND_CERTS => 1; -use constant MTN_INVENTORY_IO_STANZA_FORMAT => 2; -use constant MTN_P_SELECTOR => 3; +use constant MTN_IGNORE_SUSPEND_CERTS => 0; +use constant MTN_INVENTORY_IO_STANZA_FORMAT => 1; +use constant MTN_P_SELECTOR => 2; +# Constants used to represent the different error levels. + +use constant MTN_SEVERITY_ALL => 0x03; +use constant MTN_SEVERITY_ERROR => 0x01; +use constant MTN_SEVERITY_WARNING => 0x02; + # A pre-compiled regular expression for finding the end of a quoted string # possibly containing escaped quotes, i.e. " preceeded by a non-backslash # character or an even number of backslash characters. @@ -115,6 +121,7 @@ sub erase_ancestors($\@@); sub db_set($$$$); sub descendents($\@@); sub erase_ancestors($\@@); +sub genkey($\$$$); sub get_attributes($\$$); sub get_base_revision_id($\$); sub get_content_changed(address@hidden); @@ -137,7 +144,13 @@ sub new($;$); sub keys($$); sub leaves($\@); sub new($;$); +sub packet_for_fdata($\$$); +sub packet_for_fdelta($\$$$); +sub packet_for_rdata($\$$); +sub packets_for_certs($\$$); sub parents(address@hidden); +sub put_file($\$$\$); +sub put_revision($\$\$); sub register_db_locked_handler(;$$$); sub register_error_handler($;$$$); sub register_io_wait_handler(;$$$$); @@ -163,12 +176,15 @@ use base qw(Exporter); use base qw(Exporter); -our %EXPORT_TAGS = (constants => [qw(MTN_IGNORE_SUSPEND_CERTS - MTN_INVENTORY_IO_STANZA_FORMAT - MTN_P_SELECTOR)]); +our %EXPORT_TAGS = (capabilities => [qw(MTN_IGNORE_SUSPEND_CERTS + MTN_INVENTORY_IO_STANZA_FORMAT + MTN_P_SELECTOR)], + severities => [qw(MTN_SEVERITY_ALL + MTN_SEVERITY_ERROR + MTN_SEVERITY_WARNING)]); our @EXPORT = qw(); -Exporter::export_ok_tags(qw(constants)); -our $VERSION = 0.6; +Exporter::export_ok_tags(qw(capabilities severities)); +our $VERSION = 0.7; # ############################################################################## # @@ -367,9 +383,9 @@ sub cert($$$$) my($this, $revision_id, $name, $value) = @_; - my @dummy; + my $dummy; - return mtn_command($this, "cert", @dummy, $revision_id, $name, $value); + return mtn_command($this, "cert", \$dummy, $revision_id, $name, $value); } # @@ -687,6 +703,84 @@ sub erase_ancestors($\@@) # ############################################################################## # +# Routine - genkey +# +# Description - Generate a new key for use within the database. +# +# Data - $this : The object. +# $ref : A reference to a buffer or a hash that is to +# contain the output from this command. +# $key_id : The key id for the new key. +# $pass_phrase : The pass phrase for the key. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub genkey($\$$$) +{ + + my($this, $ref, $key_id, $pass_phrase) = @_; + + # Run the command and get the data, either as one lump or as a structured + # list. + + if (ref($ref) eq "SCALAR") + { + return mtn_command($this, "genkey", $ref, $key_id, $pass_phrase); + } + else + { + + my($i, + @lines, + $value); + + if (! mtn_command($this, "genkey", address@hidden, $key_id, $pass_phrase)) + { + return; + } + + # Reformat the data into a structured record. + + for ($i = 0, %$ref = (); $i <= $#lines; ++ $i) + { + if ($lines[$i] =~ m/^ *name \"/) + { + get_quoted_value(@lines, $i, $value); + $$ref{name} = unescape($value); + } + elsif ($lines[$i] =~ m/^ *public_hash \[[^\]]+\]$/) + { + ($value) = ($lines[$i] =~ m/^ *public_hash \[([^\]]+)\]$/); + $$ref{public_hash} = $value; + } + elsif ($lines[$i] =~ m/^ *private_hash \[[^\]]+\]$/) + { + ($value) = ($lines[$i] =~ m/^ *private_hash \[([^\]]+)\]$/); + $$ref{private_hash} = $value; + } + elsif ($lines[$i] =~ m/^ *public_location \"/) + { + get_quoted_value(@lines, $i, $value); + $$ref{public_location} = unescape($value); + } + elsif ($lines[$i] =~ m/^ *private_location \"/) + { + get_quoted_value(@lines, $i, $value); + $$ref{private_location} = unescape($value); + } + } + + return 1; + + } + +} +# +############################################################################## +# # Routine - get_attributes # # Description - Get the attributes of the specified file. @@ -1776,6 +1870,118 @@ sub leaves($\@) # ############################################################################## # +# Routine - packet_for_fdata +# +# Description - Get the contents of the file referenced by the specified +# file id in packet format. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $file_id : The file id of the file that is to be +# returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub packet_for_fdata($\$$) +{ + + my($this, $buffer, $file_id) = @_; + + return mtn_command($this, "packet_for_fdata", $buffer, $file_id); + +} +# +############################################################################## +# +# Routine - packet_for_fdelta +# +# Description - Get the file delta between the two files referenced by the +# specified file ids in packet format. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $from_file_id : The file id of the file that is to be used +# as the base in the delta operation. +# $to_file_id : The file id of the file that is to be used +# as the target in the delta operation. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub packet_for_fdelta($\$$$) +{ + + my($this, $buffer, $from_file_id, $to_file_id) = @_; + + return mtn_command + ($this, "packet_for_fdelta", $buffer, $from_file_id, $to_file_id); + +} +# +############################################################################## +# +# Routine - packet_for_rdata +# +# Description - Get the contents of the revision referenced by the +# specified revision id in packet format. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $revision_id : The revision id of the revision that is to +# be returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub packet_for_rdata($\$$) +{ + + my($this, $buffer, $revision_id) = @_; + + return mtn_command($this, "packet_for_rdata", $buffer, $revision_id); + +} +# +############################################################################## +# +# Routine - packets_for_certs +# +# Description - Get all the certs for the revision referenced by the +# specified revision id in packet format. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $revision_id : The revision id of the revision that is to +# have its certs returned. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub packets_for_certs($\$$) +{ + + my($this, $buffer, $revision_id) = @_; + + return mtn_command($this, "packets_for_certs", $buffer, $revision_id); + +} +# +############################################################################## +# # Routine - parents # # Description - Get a list of parents for the specified revision. @@ -1802,6 +2008,93 @@ sub parents(address@hidden) # ############################################################################## # +# Routine - put_file +# +# Description - Put the specified file contents into the database, +# optionally basing it on the specified file id (this is used +# for delta encoding). +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# $base_file_id : The file id of the previous version of this +# file or undef if this is a new file. +# \$contents : A reference to a buffer containing the +# file's contents. +# Return Value : True on success, otherwise false on +# failure. +# +############################################################################## + + + +sub put_file($\$$\$) +{ + + my($this, $buffer, $base_file_id, $contents) = @_; + + my @list; + + if (defined($base_file_id)) + { + if (! mtn_command($this, + "put_file", + address@hidden, + $base_file_id, + $contents)) + { + return; + } + } + else + { + if (! mtn_command($this, "put_file", address@hidden, $contents)) + { + return; + } + } + $$buffer = $list[0]; + + return 1; + +} +# +############################################################################## +# +# Routine - put_revision +# +# Description - Put the specified revision data into the database. +# +# Data - $this : The object. +# \$buffer : A reference to a buffer that is to contain +# the output from this command. +# \$contents : A reference to a buffer containing the +# revision's contents. +# Return Value : True on success, otherwise false on failure. +# +############################################################################## + + + +sub put_revision($\$\$) +{ + + my($this, $buffer, $contents) = @_; + + my @list; + + if (! mtn_command($this, "put_revision", address@hidden, $contents)) + { + return; + } + $$buffer = $list[0]; + + return 1; + +} +# +############################################################################## +# # Routine - roots # # Description - Get a list of root revisions, i.e. revisions with no @@ -2112,8 +2405,7 @@ sub ignore_suspend_certs($$) # depending upon how this method is called and # is ignored if it is present anyway. # $severity : The level of error that the handler is being -# registered for. One of "error", "warning" or -# "both". +# registered for. # $handler : A reference to the error handler routine. If # this is not provided then the existing error # handler routine is unregistered and errors @@ -2131,7 +2423,7 @@ sub register_error_handler($;$$$) shift() if ($_[0] eq __PACKAGE__ || ref($_[0]) eq __PACKAGE__); my($severity, $handler, $client_data) = @_; - if ($severity eq "error") + if ($severity == MTN_SEVERITY_ERROR) { if (defined($handler)) { @@ -2145,7 +2437,7 @@ sub register_error_handler($;$$$) $error_handler = $error_handler_data = undef; } } - elsif ($severity eq "warning") + elsif ($severity == MTN_SEVERITY_WARNING) { if (defined($handler)) { @@ -2159,7 +2451,7 @@ sub register_error_handler($;$$$) $warning_handler = $warning_handler_data = undef; } } - elsif ($severity eq "both") + elsif ($severity == MTN_SEVERITY_ALL) { if (defined($handler)) { @@ -2178,7 +2470,7 @@ sub register_error_handler($;$$$) } else { - croak("Unknown error handler severity `" . $severity . "'"); + croak("Unknown error handler severity"); } } @@ -2617,12 +2909,22 @@ sub mtn_command_with_options($$$\@@) foreach $param (@parameters) { - # The unless below is required just in case undef is passed as the - # only parameter (which can happen when a mandatory argument is not - # passed by the caller). + # Cater for passing by reference (useful when sending large lumps + # of data as in put_file). Also defend against undef being passed + # as the only parameter (which can happen when a mandatory argument + # is not passed by the caller). - printf($in "%d:%s", length($param), $param) - unless (! defined($param)); + if (defined $param) + { + if (ref($param) ne "") + { + printf($in "%d:%s", length($$param), $$param); + } + else + { + printf($in "%d:%s", length($param), $param); + } + } } print($in "e\n"); @@ -3002,7 +3304,7 @@ sub error_handler_wrapper($) my $message = $_[0]; - &$error_handler("error", $message, $error_handler_data); + &$error_handler(MTN_SEVERITY_ERROR, $message, $error_handler_data); croak(__PACKAGE__ . ": Fatal error."); } @@ -3026,7 +3328,7 @@ sub warning_handler_wrapper($) my $message = $_[0]; - &$warning_handler("warning", $message, $warning_handler_data); + &$warning_handler(MTN_SEVERITY_WARNING, $message, $warning_handler_data); } ============================================================ --- Monotone/AutomateStdio.pod d54fc235262827b1cf8a06dc569ca97cfae02458 +++ Monotone/AutomateStdio.pod f02a38ab6c1e084ff0f2e1277abed9a8c5e17740 @@ -6,11 +6,11 @@ Monotone::AutomateStdio - Perl interface =head1 VERSION -0.6 +0.7 =head1 SYNOPSIS - use Monotone::AutomateStdio qw(:constants); + use Monotone::AutomateStdio qw(:capabilities :severities); my(@manifest, $mtn, @revs); @@ -33,24 +33,11 @@ $mtn-Eclosedown() is called. called. The subprocess is terminated on object destruction or when $mtn-Eclosedown() is called. -All automate commands have been implemented in this class except for the -following: +All 0.35 automate commands have been implemented in this class except for the +`stdio' command, which hopefully is obvious. :-) I am currently working on +supporting versions of Monotone from 0.35 onwards (0.40 works with this +library, it is just that you will not be able to use the new features). - genkey - packet_for_fdata - packet_for_fdelta - packet_for_rdata - packets_for_certs - put_file - put_revision - stdio - -The `genkey' command is typically done by the user when setting up their -account and so is not likely to be of great use the rest of the time, the -`packet' style commands seem to be of little use to a scripting language, the -`put' style commands just seem too scary for words and hopefully you do not -have to ask about the `stdio' command. :-) - =head1 CONSTRUCTORS =over 4 @@ -75,16 +62,17 @@ errors of a certain severity as specifie Registers the handler specified as a subroutine reference in $handler for errors of a certain severity as specified by $severity. $severity can be one of -"warning", "error" or "both". The value of $client_data is simply passed to the -handler and can be used by the caller to provide a context. This is a class -method rather than an object one as errors can be raised when calling a -constructor. If no handler is given then the error handling is reset to the -default behaviour for that severity level. +MTN_SEVERITY_WARNING, MTN_SEVERITY_ERROR or MTN_SEVERITY_ALL. The value of +$client_data is simply passed to the handler and can be used by the caller to +provide a context. This is a class method rather than an object one as errors +can be raised when calling a constructor. If no handler is given then the error +handling is reset to the default behaviour for that severity level. The handler subroutine is given three arguments, the first one is a severity -string that indicates the severity of the error being handled (either "warning" -or "error"), the second one is the error message and the third is the value -passed in as $client_data when the hander was registered. +string that indicates the severity of the error being handled (either +MTN_SEVERITY_WARNING or MTN_SEVERITY_ERROR), the second one is the error +message and the third is the value passed in as $client_data when the hander +was registered. Please note: @@ -109,10 +97,10 @@ boolean success indicator, errors always =item 3) -If the severity is "error" then it is expected that croak or die will be called -by the handler, if this is not the case then this class will call croak() upon -return. If you need to trap errors and prevent program exit then use an eval -block to protect yourself in the calling code. +If the severity is MTN_SEVERITY_ERROR then it is expected that croak or die +will be called by the handler, if this is not the case then this class will +call croak() upon return. If you need to trap errors and prevent program exit +then use an eval block to protect yourself in the calling code. =item 4) @@ -120,6 +108,13 @@ methods in this class. one routine rather than checking the boolean success indicator returned by most methods in this class. +=item 5) + +In order to get the severity constants into your namespace you need to use the +following to load in this library. + + use Monotone::AutomateStdio qw(:severities); + =back =item Bregister_db_locked_handler([$handler[, @@ -175,11 +170,12 @@ automate commands. See http://monotone.ca/monotone.html for a complete description of the mtn automate commands. -Methods that return data do so via their first argument. This argument is a -reference to either a scalar or a list depending upon whether the data returned -by the method is raw data or a list of items respectively. Methods that return -lists of records also provide the option of returning the data as one raw chunk -if the reference points to a scalar rather than a list. Therefore: +Methods that return data from the mtn subprocess do so via their first +argument. This argument is a reference to either a scalar or a list depending +upon whether the data returned by the method is raw data or a list of items +respectively. Methods that return lists of records also provide the option of +returning the data as one raw chunk if the reference points to a scalar rather +than a list. Therefore: $mtn->get_manifest_of(\$buffer); @@ -200,6 +196,10 @@ revision id rather than a record). will always need a reference to a list (each item is just a string containing a revision id rather than a record). +The one exception to the above is the $mtn-Egenkey() method, which expects +a reference to either a scalar or a hash as it only ever returns one record's +worth of information. + The remaining arguments depend upon the mtn command being used. The following methods are provided: @@ -232,7 +232,7 @@ following to load in this library. In order to get these constants into your namespace you need to use the following to load in this library. - use Monotone::AutomateStdio qw(:constants); + use Monotone::AutomateStdio qw(:capabilities); Please note that if you see (feature: ...) then this means that whatever is being discussed is only available if $mtn-Ecan() returns true for the @@ -298,6 +298,23 @@ revisions specified within the list. For a given list of revisions, weed out those that are ancestors to other revisions specified within the list. +=item B<$mtn-Egenkey(\$buffer | \%hash, $key_id, $pass_phrase)> + +Generate a new key for use within the database. If \$buffer is passed then the +output from the command is simply placed into the variable. However if \%hash +is passed then the output is returned as one anonymous hash containing the +following fields: + + name - The name of the key. + public_hash - The public hash code. + private_hash - The private hash code. + public_locations - A list of locations for the public hash code. + Values can be one of "database" or + "keystore". + private_locations - A list of locations for the private hash + code. Values can be one of "database" or + "keystore". + =item B<$mtn-Eget_attributes(\$buffer, $file_name)> Get the attributes of the specified file. If \$buffer is passed then the output @@ -514,10 +531,42 @@ Get a list of leaf revisions. Get a list of leaf revisions. +=item B<$mtn-Epacket_for_fdata(\$buffer, $file_id)> + +Get the contents of the file referenced by the specified file id in packet +format. + +=item B<$mtn-Epacket_for_fdelta(\$buffer, $from_file_id, $to_file_id)> + +Get the file delta between the two files referenced by the specified file ids +in packet format. + +=item B<$mtn-Epacket_for_rdata(\$buffer, $revision_id)> + +Get the contents of the revision referenced by the specified revision id in +packet format. + +=item B<$mtn-Epackets_for_certs(\$buffer, $revision_id)> + +Get all the certs for the revision referenced by the specified revision id in +packet format. + =item B<$mtn-Eparents(address@hidden, $revision_id)> Get a list of parents for the specified revision. +=item B<$mtn-Eput_file(\$buffer, $base_file_id, \$contents)> + +Put the specified file contents into the database, optionally basing it on the +specified file id (this is used for delta encoding). The file id is returned. + +=item B<$mtn-Eput_revision(\$buffer, \$contents)> + +Put the specified revision data into the database. The revision id is +returned. Please note that any newly created revisions have no certificates +associated with them and so these have to be added using the $mtn-Ecert() +method. + =item B<$mtn-Eregister_db_locked_handler([$handler[, $client_data]])> Registers a database locked handler for the object rather than the class. For @@ -575,10 +624,6 @@ $mtn-Eclosedown() do not return anyt =head1 NOTES -The Monotone::AutomateStdio class, with the exception of the $mtn-Ecert() -and $mtn-Edb_set() methods, provides a read-only interface to a Monotone -database. This is a deliberate safety precaution for now. - There are situations where this class does legitimately terminate or even restart the mtn subprocess (for example when a database locked condition is detected). Therefore if you wish to detect and handle SIGCHLD signals in your ============================================================ --- mtn-tester c18eaecac2098aafe8f70660d778cdd0bfba71ba +++ mtn-tester b83629177793a803fc08529166e89f1612956bbd @@ -10,16 +10,18 @@ use GDBM_File; use Storable; use Data::Dumper; use GDBM_File; +use IO::File; use IO::Handle; -use Monotone::AutomateStdio; +use Monotone::AutomateStdio qw(:capabilities :severities); use Data::Dumper; my($data, + %hash, @list, $mtn); Monotone::AutomateStdio->register_error_handler - ("both", + (MTN_SEVERITY_ALL, sub { my($severity, $message) = @_; @@ -452,6 +454,92 @@ else print Dumper(address@hidden); } +if (! $mtn->packet_for_fdata(\$data, + "38d8ad417471d7ac2724e477eaafd1a59581ca8a")) +{ + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->packet_for_fdelta(\$data, + "a152991b3936bd8b49e9392fd908e882a7c13c4b", + "38d8ad417471d7ac2724e477eaafd1a59581ca8a")) +{ + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->packet_for_rdata(\$data, + "d7cfaacc152a049d004587192cc5a8979d051c14")) +{ + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); +} +else +{ + print Dumper(\$data); +} + +if (! $mtn->packets_for_certs(\$data, + "d7cfaacc152a049d004587192cc5a8979d051c14")) +{ + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); +} +else +{ + print Dumper(\$data); +} + +if (1 == 0) +{ + if (! $mtn->genkey(\%hash, 'address@hidden', "bear of little brain")) + { + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); + } + else + { + print Dumper(\%hash); + } +} + +my $data_file = IO::File->new("../mtn-tester", "r"); +my $fdata; +$data_file->sysread($fdata, 64000); +$data_file = undef; +if (! $mtn->put_file(\$data, undef, $fdata)) +{ + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); +} +else +{ + print Dumper(\$data); +} +my $base_rev; +$mtn->get_base_revision_id(\$base_rev); +$fdata = "format_version \"1\"\n\n" + . "new_manifest [0000000000000000000000000000000000000000]\n\n" + . "old_revision [" . $base_rev . "]\n\n" + . "add_file \"mtn-tester\"\n" + . " content [" . $data . "]\n"; +print $fdata; +if (! $mtn->put_revision(\$data, $fdata)) +{ + printf(STDERR "OOPS: %s\n", $mtn->get_error_message()); +} +else +{ + print Dumper(\$data); +} +$mtn->cert($data, "author", "address@hidden"); +$mtn->cert($data, "branch", "net.venge.monotone"); +$mtn->cert($data, "changelog", "Automated checkin."); +$mtn->cert($data, "date", "2008-08-31T18:42:30"); + printf("Last error message `%s'\n", $mtn->get_error_message()); print Dumper (\$mtn);