CDS
view release on metacpan or search on metacpan
my $label = shift;
my $value = shift;
$o->{currentBatch}->{boxLabel} = 'messages';
}
sub collectObject {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{hash} = $value->hash;
$o->{store} = $value->cliStore;
}
sub collectPrivate {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{boxLabel} = 'private';
}
sub collectPrivate1 {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{currentBatch}->{boxLabel} = 'private';
}
sub collectPublic {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{boxLabel} = 'public';
}
sub collectPublic1 {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{currentBatch}->{boxLabel} = 'public';
}
sub collectStore {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{store} = $value;
}
sub collectWatch {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{watchTimeout} = 60000;
}
sub new {
my $class = shift;
my $actor = shift;
bless {actor => $actor, ui => $actor->ui} }
# END AUTOGENERATED
# HTML FOLDER NAME curl
# HTML TITLE Curl
sub help {
my $o = shift;
my $cmd = shift;
my $ui = $o->{ui};
$ui->space;
$ui->p($ui->blue('cds curl'), ' prepares and executes a CURL command line for a HTTP store request. This is helpful for debugging a HTTP store implementation. Outside of low-level debugging, it is more convenient to use the "cds get|put|list|add|rem...
$ui->space;
$ui->command('cds curl get OBJECT');
$ui->command('cds curl get HASH [from|on STORE]');
$ui->p('Downloads an object with a GET request on an object store.');
$ui->space;
$ui->command('cds curl put FILE [onto STORE]');
$ui->p('Uploads an object with a PUT request on an object store.');
$ui->space;
$ui->command('cds curl book OBJECT');
$ui->command('cds curl book HASH [on STORE]');
$ui->p('Books an object with a POST request on an object store.');
$ui->space;
$ui->command('cds curl list message box of ACTOR [on STORE]');
$ui->command('cds curl list private box of ACTOR [on STORE]');
$ui->command('cds curl list public box of ACTOR [on STORE]');
$ui->p('Lists the indicated box with a GET request on an account store.');
$ui->space;
$ui->command('cds curl watch message box of ACTOR [on STORE]');
$ui->command('cds curl watch private box of ACTOR [on STORE]');
$ui->command('cds curl watch public box of ACTOR [on STORE]');
$ui->p('As above, but with a watch timeout of 60 second.');
$ui->space;
$ui->command('cds curl add (FILE|HASH)* to (message|private|public) box of ACTOR [and …] [on STORE]');
$ui->command('cds curl remove HASH* from (message|private|public) box of ACTOR [and …] [on STORE]');
$ui->p('Modifies the indicated boxes with a POST request on an account store. Multiple modifications to different boxes may be chained using "and". All modifications are submitted using a single request, which is optionally signed (see below).');
$ui->space;
$ui->command('… using KEYPAIR');
$ui->p('Signs the request using KEYPAIR instead of the actor\'s key pair. The store may or may not verify the signature.');
$ui->p('For debugging purposes, information about the signature is stored as ".cds-curl-bytes-to-sign", ".cds-curl-hash-to-sign", and ".cds-curl-signature" in the current folder. Note that signatures are valid for 1-2 minutes only. After that, serve...
$ui->space;
}
sub curlGet {
my $o = shift;
my $cmd = shift;
$cmd->collect($o);
$o->{keyPairToken} = $o->{actor}->preferredKeyPairToken if ! $o->{keyPairToken};
$o->{store} = $o->{actor}->preferredStore if ! $o->{store};
my $objectToken = CDS::ObjectToken->new($o->{store}, $o->{hash});
$o->curlRequest('GET', $objectToken->url, ['--output', $o->{hash}->hex]);
}
sub curlPut {
my $o = shift;
my $cmd = shift;
$cmd->collect($o);
$o->{keyPairToken} = $o->{actor}->preferredKeyPairToken if ! $o->{keyPairToken};
$o->{store} = $o->{actor}->preferredStore if ! $o->{store};
my $bytes = CDS->readBytesFromFile($o->{file}) // return $o->{ui}->error('Unable to read "', $o->{file}, '".');
my $hash = CDS::Hash->calculateFor($bytes);
my $objectToken = CDS::ObjectToken->new($o->{store}, $hash);
$o->curlRequest('PUT', $objectToken->url, ['--data-binary', '@'.$o->{file}, '-H', 'Content-Type: application/condensation-object']);
}
sub curlBook {
my $o = shift;
my $cmd = shift;
$cmd->collect($o);
$o->{keyPairToken} = $o->{actor}->preferredKeyPairToken if ! $o->{keyPairToken};
$o->{store} = $o->{actor}->preferredStore if ! $o->{store};
my $objectToken = CDS::ObjectToken->new($o->{store}, $o->{hash});
$o->curlRequest('POST', $objectToken->url, []);
}
sub curlList {
my $o = shift;
my $cmd = shift;
$cmd->collect($o);
$o->{keyPairToken} = $o->{actor}->preferredKeyPairToken if ! $o->{keyPairToken};
$o->{store} = $o->{actor}->preferredStore if ! $o->{store};
$o->{actorHash} = $o->{actor}->preferredActorHash if ! $o->{actorHash};
my $boxToken = CDS::BoxToken->new(CDS::AccountToken->new($o->{store}, $o->{actorHash}), $o->{boxLabel});
my $args = ['--output', '.cds-curl-list'];
push @$args, '-H', 'Condensation-Watch: '.$o->{watchTimeout}.' ms' if $o->{watchTimeout};
$o->curlRequest('GET', $boxToken->url, $args);
}
sub curlModify {
my $o = shift;
my $cmd = shift;
$o->{currentBatch} = {
addHashes => [],
addEnvelopes => [],
removeHashes => [],
};
$o->{batches} = [];
$cmd->collect($o);
$o->{keyPairToken} = $o->{actor}->preferredKeyPairToken if ! $o->{keyPairToken};
$o->{store} = $o->{actor}->preferredStore if ! $o->{store};
# Prepare the modifications
my $modifications = CDS::StoreModifications->new;
for my $batch (@{$o->{batches}}, $o->{currentBatch}) {
$batch->{actorHash} = $o->{actor}->preferredActorHash if ! $batch->{actorHash};
for my $hash (@{$batch->{addHashes}}) {
$modifications->add($batch->{actorHash}, $batch->{boxLabel}, $hash);
}
for my $file (@{$batch->{addFiles}}) {
my $bytes = CDS->readBytesFromFile($file) // return $o->{ui}->error('Unable to read "', $file, '".');
my $object = CDS::Object->fromBytes($bytes) // return $o->{ui}->error('"', $file, '" is not a Condensation object.');
my $hash = $object->calculateHash;
$o->{ui}->warning('"', $file, '" is not a valid envelope. The server may reject it.') if ! $o->{actor}->isEnvelope($object);
$modifications->add($batch->{actorHash}, $batch->{boxLabel}, $hash, $object);
}
for my $hash (@{$batch->{removeHashes}}) {
$modifications->remove($batch->{actorHash}, $batch->{boxLabel}, $hash);
}
}
$o->{ui}->warning('You didn\'t specify any changes. The server should accept, but ignore this.') if $modifications->isEmpty;
# Write a new file
my $modificationsObject = $modifications->toRecord->toObject;
my $modificationsHash = $modificationsObject->calculateHash;
my $file = '.cds-curl-modifications-'.substr($modificationsHash->hex, 0, 8);
CDS->writeBytesToFile($file, $modificationsObject->header, $modificationsObject->data) // return $o->{ui}->error('Unable to write modifications to "', $file, '".');
$o->{ui}->line(scalar @{$modifications->additions}, ' addition(s) and ', scalar @{$modifications->removals}, ' removal(s) written to "', $file, '".');
# Submit
$o->curlRequest('POST', $o->{store}->url.'/accounts', ['--data-binary', '@'.$file, '-H', 'Content-Type: application/condensation-modifications'], $modificationsObject);
}
sub curlRequest {
my $o = shift;
my $method = shift;
my $url = shift;
my $curlArgs = shift;
my $contentObjectToSign = shift;
my $label = shift;
my $value = shift;
push @{$o->{boxTokens}}, $value;
}
sub collectKeypair {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{actorHash} = $value->keyPair->publicKey->hash;
$o->{keyPairToken} = $value;
}
sub collectMessages {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{boxLabels} = ['messages'];
}
sub collectMy {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{my} = 1;
}
sub collectPrivate {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{boxLabels} = ['private'];
}
sub collectPublic {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{boxLabels} = ['public'];
}
sub collectStore {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{store} = $value;
}
sub collectWatch {
my $o = shift;
my $label = shift;
my $value = shift;
$o->{watchTimeout} = 60000;
}
sub new {
my $class = shift;
my $actor = shift;
bless {actor => $actor, ui => $actor->ui} }
# END AUTOGENERATED
# HTML FOLDER NAME store-list
# HTML TITLE List
sub help {
my $o = shift;
my $cmd = shift;
my $ui = $o->{ui};
$ui->space;
$ui->command('cds list BOX');
$ui->p('Lists the indicated box. The object references are shown as "cds open envelope …" command, which can be executed to display the corresponding envelope. Change the command to "cds get …" to download the raw object, or "cds show record …...
$ui->space;
$ui->command('cds list');
$ui->p('Lists all boxes of the selected key pair.');
$ui->space;
$ui->command('cds list BOXLABEL');
$ui->p('Lists only the indicated box of the selected key pair. BOXLABEL may be:');
$ui->line(' message box');
$ui->line(' public box');
$ui->line(' private box');
$ui->space;
$ui->command('cds list my boxes');
$ui->command('cds list my BOXLABEL');
$ui->p('Lists your own boxes.');
$ui->space;
$ui->command('cds list [BOXLABEL of] ACTORGROUP|ACCOUNT');
$ui->p('Lists boxes of an actor group, or account.');
$ui->space;
$ui->command('cds list [BOXLABEL of] KEYPAIR|ACTOR [on STORE]');
$ui->p('Lists boxes of an actor on the specified or selected store.');
$ui->space;
}
sub listBoxes {
my $o = shift;
my $cmd = shift;
$o->{boxTokens} = [];
$o->{boxLabels} = ['messages', 'private', 'public'];
$cmd->collect($o);
# Use the selected key pair to sign requests
$o->{keyPairToken} = $o->{actor}->preferredKeyPairToken if ! $o->{keyPairToken};
for my $boxToken (@{$o->{boxTokens}}) {
$o->listBox($boxToken);
}
$o->{ui}->space;
}
sub list {
my $o = shift;
my $cmd = shift;
$o->{boxLabels} = ['messages', 'private', 'public'];
$cmd->collect($o);
# Actor hashes
my @actorHashes;
my @stores;
if ($o->{my}) {
$o->{keyPairToken} = $o->{actor}->keyPairToken;
push @actorHashes, $o->{keyPairToken}->keyPair->publicKey->hash;
push @stores, $o->{actor}->storageStore, $o->{actor}->messagingStore;
} elsif ($o->{actorHash}) {
push @actorHashes, $o->{actorHash};
} elsif ($o->{actorGroup}) {
# TODO
} else {
push @actorHashes, $o->{actor}->preferredActorHash;
}
# Stores
push @stores, $o->{store} if $o->{store};
push @stores, $o->{actor}->preferredStore if ! scalar @stores;
# Use the selected key pair to sign requests
my $preferredKeyPairToken = $o->{actor}->preferredKeyPairToken;
$o->{keyPairToken} = $preferredKeyPairToken if ! $o->{keyPairToken};
$o->{keyPairContext} = $preferredKeyPairToken->keyPair->equals($o->{keyPairToken}->keyPair) ? '' : $o->{ui}->gray(' using ', $o->{actor}->keyPairReference($o->{keyPairToken}));
# List boxes
for my $store (@stores) {
for my $actorHash (@actorHashes) {
for my $boxLabel (@{$o->{boxLabels}}) {
$o->listBox(CDS::BoxToken->new(CDS::AccountToken->new($store, $actorHash), $boxLabel));
}
}
}
$o->{ui}->space;
}
sub listBox {
my $o = shift;
my $boxToken = shift;
$o->{ui}->space;
$o->{ui}->title($o->{actor}->blueBoxReference($boxToken));
# Query the store
my $store = $boxToken->accountToken->cliStore;
my ($hashes, $storeError) = $store->list($boxToken->accountToken->actorHash, $boxToken->boxLabel, $o->{watchTimeout} // 0, $o->{keyPairToken}->keyPair);
return if defined $storeError;
# Print the result
my $count = scalar @$hashes;
return if ! $count;
my $context = $boxToken->boxLabel eq 'messages' ? $o->{ui}->gray(' on ', $o->{actor}->storeReference($store)) : $o->{ui}->gray(' from ', $o->{actor}->accountReference($boxToken->accountToken));
my $keyPairContext = $boxToken->boxLabel eq 'public' ? '' : $o->{keyPairContext} // '';
foreach my $hash (sort { $a->bytes cmp $b->bytes } @$hashes) {
$o->{ui}->line($o->{ui}->gold('cds open envelope ', $hash->hex), $context, $keyPairContext);
}
$o->{ui}->line($count.' entries') if $count > 5;
}
# BEGIN AUTOGENERATED
package CDS::Commands::Modify;
sub register {
my $class = shift;
my $cds = shift;
my $help = shift;
my $node000 = CDS::Parser::Node->new(0);
my $node001 = CDS::Parser::Node->new(0);
my $node002 = CDS::Parser::Node->new(0);
my $node003 = CDS::Parser::Node->new(0);
my $node004 = CDS::Parser::Node->new(0);
my $node005 = CDS::Parser::Node->new(0);
my $node006 = CDS::Parser::Node->new(0);
my $node007 = CDS::Parser::Node->new(1, {constructor => \&new, function => \&help});
my $node008 = CDS::Parser::Node->new(1);
my $node009 = CDS::Parser::Node->new(0);
my $node010 = CDS::Parser::Node->new(0);
my $node011 = CDS::Parser::Node->new(0);
my $node012 = CDS::Parser::Node->new(0);
my $node013 = CDS::Parser::Node->new(0);
my $node014 = CDS::Parser::Node->new(0);
my $node015 = CDS::Parser::Node->new(0);
my $node016 = CDS::Parser::Node->new(1, {constructor => \&new, function => \&modify});
$cds->addDefault($node000);
$help->addArrow($node007, 1, 0, 'add');
$help->addArrow($node007, 1, 0, 'purge');
$help->addArrow($node007, 1, 0, 'remove');
$node000->addArrow($node001, 1, 0, 'add');
$node000->addArrow($node002, 1, 0, 'remove');
$node000->addArrow($node003, 1, 0, 'add');
$node000->addArrow($node008, 1, 0, 'purge', \&collectPurge);
$node001->addArrow($node001, 1, 0, 'HASH', \&collectHash);
$node001->addArrow($node004, 1, 0, 'HASH', \&collectHash);
$node002->addArrow($node002, 1, 0, 'HASH', \&collectHash1);
$node002->addArrow($node005, 1, 0, 'HASH', \&collectHash1);
$node003->addArrow($node003, 1, 0, 'FILE', \&collectFile);
$node003->addArrow($node006, 1, 0, 'FILE', \&collectFile);
$node004->addArrow($node008, 1, 0, 'to');
$node005->addArrow($node008, 1, 0, 'from');
$node006->addArrow($node008, 1, 0, 'to');
$node008->addArrow($node000, 1, 0, 'and');
$node008->addArrow($node009, 1, 0, 'message');
$node008->addArrow($node010, 1, 0, 'private');
$node008->addArrow($node011, 1, 0, 'public');
if (-d $file) {
return $request->reply404 if ! length $o->{defaultFile};
return $request->reply303($request->path.'/') if $file !~ /\/$/;
$file .= $o->{defaultFile};
}
return $o->deliverFile($request, $file);
}
sub deliverFile {
my $o = shift;
my $request = shift;
my $file = shift;
my $contentType = shift // $o->guessContentType($file);
my $bytes = $o->readFile($file) // return $request->reply404;
return $request->reply(200, 'OK', {'Content-Type' => $contentType}, $bytes);
}
# Guesses the content type from the extension
sub guessContentType {
my $o = shift;
my $file = shift;
my $extension = $file =~ /\.([A-Za-z0-9]*)$/ ? lc($1) : '';
return $o->{mimeTypesByExtension}->{$extension} // 'application/octet-stream';
}
# Reads a file
sub readFile {
my $o = shift;
my $file = shift;
open(my $fh, '<:bytes', $file) || return;
if (! -f $fh) {
close $fh;
return;
}
local $/ = undef;
my $bytes = <$fh>;
close $fh;
return $bytes;
}
package CDS::HTTPServer::StoreHandler;
sub new {
my $class = shift;
my $root = shift;
my $store = shift;
my $checkPutHash = shift;
my $checkSignatures = shift // 1;
return bless {
root => $root,
store => $store,
checkPutHash => $checkPutHash,
checkEnvelopeHash => $checkPutHash,
checkSignatures => $checkSignatures,
maximumWatchTimeout => 0,
};
}
sub process {
my $o = shift;
my $request = shift;
my $path = $request->pathAbove($o->{root}) // return;
# Objects request
if ($request->path =~ /^\/objects\/([0-9a-f]{64})$/) {
my $hash = CDS::Hash->fromHex($1);
return $o->objects($request, $hash);
}
# Box request
if ($request->path =~ /^\/accounts\/([0-9a-f]{64})\/(messages|private|public)$/) {
my $accountHash = CDS::Hash->fromHex($1);
my $boxLabel = $2;
return $o->box($request, $accountHash, $boxLabel);
}
# Box entry request
if ($request->path =~ /^\/accounts\/([0-9a-f]{64})\/(messages|private|public)\/([0-9a-f]{64})$/) {
my $accountHash = CDS::Hash->fromHex($1);
my $boxLabel = $2;
my $hash = CDS::Hash->fromHex($3);
return $o->boxEntry($request, $accountHash, $boxLabel, $hash);
}
# Account request
if ($request->path =~ /^\/accounts\/([0-9a-f]{64})$/) {
return $request->replyOptions if $request->method eq 'OPTIONS';
return $request->reply405;
}
# Accounts request
if ($request->path =~ /^\/accounts$/) {
return $o->accounts($request);
}
# Other requests on /objects or /accounts
if ($request->path =~ /^\/(accounts|objects)(\/|$)/) {
return $request->reply404;
}
# Nothing for us
return;
}
sub objects {
my $o = shift;
my $request = shift;
my $hash = shift; die 'wrong type '.ref($hash).' for $hash' if defined $hash && ref $hash ne 'CDS::Hash';
# Options
if ($request->method eq 'OPTIONS') {
return $request->replyOptions('HEAD', 'GET', 'PUT', 'POST');
}
# Retrieve object
if ($request->method eq 'HEAD' || $request->method eq 'GET') {
my ($object, $error) = $o->{store}->get($hash);
return $request->replyFatalError($error) if defined $error;
return $request->reply404 if ! $object;
# We don't check the SHA256 sum here - this should be done by the client
return $request->reply200Bytes($object->bytes);
}
# Put object
if ($request->method eq 'PUT') {
my $bytes = $request->readData // return $request->reply400('No data received.');
my $object = CDS::Object->fromBytes($bytes) // return $request->reply400('Not a Condensation object.');
return $request->reply400('SHA256 sum does not match hash.') if $o->{checkPutHash} && ! $object->calculateHash->equals($hash);
if ($o->{checkSignatures}) {
my $checkSignatureStore = CDS::CheckSignatureStore->new($o->{store});
$checkSignatureStore->put($hash, $object);
return $request->reply403 if ! $request->checkSignature($checkSignatureStore);
}
my $error = $o->{store}->put($hash, $object);
return $request->replyFatalError($error) if defined $error;
return $request->reply200;
}
# Book object
if ($request->method eq 'POST') {
return $request->reply403 if $o->{checkSignatures} && ! $request->checkSignature($o->{store});
return $request->reply400('You cannot send data when booking an object.') if $request->remainingData;
my ($booked, $error) = $o->{store}->book($hash);
return $request->replyFatalError($error) if defined $error;
return $booked ? $request->reply200 : $request->reply404;
}
return $request->reply405;
}
sub box {
my $o = shift;
my $request = shift;
my $accountHash = shift; die 'wrong type '.ref($accountHash).' for $accountHash' if defined $accountHash && ref $accountHash ne 'CDS::Hash';
my $boxLabel = shift;
# Options
if ($request->method eq 'OPTIONS') {
return $request->replyOptions('HEAD', 'GET', 'PUT', 'POST');
}
# List box
if ($request->method eq 'HEAD' || $request->method eq 'GET') {
if ($o->{checkSignatures}) {
my $actorHash = $request->checkSignature($o->{store});
return $request->reply403 if ! $o->verifyList($actorHash, $accountHash, $boxLabel);
}
my $watch = $request->headers->{'condensation-watch'} // '';
my $timeout = $watch =~ /^(\d+)\s*ms$/ ? $1 + 0 : 0;
$timeout = $o->{maximumWatchTimeout} if $timeout > $o->{maximumWatchTimeout};
my ($hashes, $error) = $o->{store}->list($accountHash, $boxLabel, $timeout);
return $request->replyFatalError($error) if defined $error;
return $request->reply200Bytes(join('', map { $_->bytes } @$hashes));
}
return $request->reply405;
}
sub boxEntry {
my $o = shift;
my $request = shift;
my $accountHash = shift; die 'wrong type '.ref($accountHash).' for $accountHash' if defined $accountHash && ref $accountHash ne 'CDS::Hash';
my $boxLabel = shift;
my $hash = shift; die 'wrong type '.ref($hash).' for $hash' if defined $hash && ref $hash ne 'CDS::Hash';
# Options
if ($request->method eq 'OPTIONS') {
return $request->replyOptions('HEAD', 'PUT', 'DELETE');
}
# Add
if ($request->method eq 'PUT') {
if ($o->{checkSignatures}) {
my $actorHash = $request->checkSignature($o->{store});
return $request->reply403 if ! $o->verifyAddition($actorHash, $accountHash, $boxLabel, $hash);
}
my $error = $o->{store}->add($accountHash, $boxLabel, $hash);
return $request->replyFatalError($error) if defined $error;
return $request->reply200;
}
# Remove
if ($request->method eq 'DELETE') {
if ($o->{checkSignatures}) {
my $actorHash = $request->checkSignature($o->{store});
return $request->reply403 if ! $o->verifyRemoval($actorHash, $accountHash, $boxLabel, $hash);
}
my ($booked, $error) = $o->{store}->remove($accountHash, $boxLabel, $hash);
return $request->replyFatalError($error) if defined $error;
return $request->reply200;
}
return $request->reply405;
}
sub accounts {
my $o = shift;
my $request = shift;
# Options
if ($request->method eq 'OPTIONS') {
return $request->replyOptions('POST');
}
# Modify boxes
if ($request->method eq 'POST') {
my $bytes = $request->readData // return $request->reply400('No data received.');
my $modifications = CDS::StoreModifications->fromBytes($bytes);
$o->log('remove', $accountHash->shortHex . ' ' . $boxLabel . ' ' . $hash->shortHex, defined $error ? 'failed: '.$error : 'OK', $elapsed);
return $error;
}
sub modify {
my $o = shift;
my $modifications = shift;
my $keyPair = shift; die 'wrong type '.ref($keyPair).' for $keyPair' if defined $keyPair && ref $keyPair ne 'CDS::KeyPair';
my $start = CDS::C::performanceStart();
my $error = $o->{store}->modify($modifications, $keyPair);
my $elapsed = CDS::C::performanceElapsed($start);
$o->log('modify', scalar(keys %{$modifications->objects}) . ' objects ' . scalar @{$modifications->additions} . ' additions ' . scalar @{$modifications->removals} . ' removals', defined $error ? 'failed: '.$error : 'OK', $elapsed);
return $error;
}
sub log {
my $o = shift;
my $cmd = shift;
my $input = shift;
my $output = shift;
my $elapsed = shift;
my $fh = $o->{fileHandle} // return;
print $fh $o->{prefix}, &left(8, $cmd), &left(40, $input), ' => ', &left(40, $output), &formatDuration($elapsed), ' us', "\n";
}
sub left {
my $width = shift;
my $text = shift;
# private
return $text . (' ' x ($width - length $text)) if length $text < $width;
return $text;
}
sub formatByteLength {
my $byteLength = shift;
# private
my $s = ''.$byteLength;
$s = ' ' x (9 - length $s) . $s if length $s < 9;
my $len = length $s;
return substr($s, 0, $len - 6).' '.substr($s, $len - 6, 3).' '.substr($s, $len - 3, 3);
}
sub formatDuration {
my $elapsed = shift;
# private
my $s = ''.$elapsed;
$s = ' ' x (9 - length $s) . $s if length $s < 9;
my $len = length $s;
return substr($s, 0, $len - 6).' '.substr($s, $len - 6, 3).' '.substr($s, $len - 3, 3);
}
# Reads the message box of an actor.
package CDS::MessageBoxReader;
sub new {
my $class = shift;
my $pool = shift;
my $actorOnStore = shift; die 'wrong type '.ref($actorOnStore).' for $actorOnStore' if defined $actorOnStore && ref $actorOnStore ne 'CDS::ActorOnStore';
my $streamTimeout = shift;
return bless {
pool => $pool,
actorOnStore => $actorOnStore,
streamCache => CDS::StreamCache->new($pool, $actorOnStore, $streamTimeout // CDS->MINUTE),
entries => {},
};
}
sub pool { shift->{pool} }
sub actorOnStore { shift->{actorOnStore} }
sub read {
my $o = shift;
my $timeout = shift // 0;
my $store = $o->{actorOnStore}->store;
my ($hashes, $listError) = $store->list($o->{actorOnStore}->publicKey->hash, 'messages', $timeout, $o->{pool}->{keyPair});
return if defined $listError;
for my $hash (@$hashes) {
my $entry = $o->{entries}->{$hash->bytes};
$o->{entries}->{$hash->bytes} = $entry = CDS::MessageBoxReader::Entry->new($hash) if ! $entry;
next if $entry->{processed};
# Check the sender store, if necessary
if ($entry->{waitingForStore}) {
my ($dummy, $checkError) = $entry->{waitingForStore}->get(CDS->emptyBytesHash, $o->{pool}->{keyPair});
next if defined $checkError;
}
# Get the envelope
my ($object, $getError) = $o->{actorOnStore}->store->get($entry->{hash}, $o->{pool}->{keyPair});
return if defined $getError;
# Mark the entry as processed
$entry->{processed} = 1;
if (! defined $object) {
$o->invalid($entry, 'Envelope object not found.');
next;
}
# Parse the record
my $envelope = CDS::Record->fromObject($object);
if (! $envelope) {
$o->invalid($entry, 'Envelope is not a record.');
next;
}
my $message =
$envelope->contains('head') && $envelope->contains('mac') ?
$o->readStreamMessage($entry, $envelope) :
$o->readNormalMessage($entry, $envelope);
next if ! $message;
$o->{pool}->{delegate}->onMessageBoxEntry($message);
}
$o->{streamCache}->removeObsolete;
return 1;
}
sub readNormalMessage {
my $o = shift;
( run in 1.961 second using v1.01-cache-2.11-cpan-39bf76dae61 )