view release on metacpan or  search on metacpan

lib/CDS.pm  view on Meta::CPAN

	$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;

	# Parse the URL
	$url =~ /^(https?):\/\/([^\/]+)(\/.*|)$/i || return $o->{ui}->error('"', $url, '" does not look like a valid and complete http://… or https://… URL.');
	my $protocol = lc($1);
	my $host = $2;
	my $path = $3;

	# Strip off user and password, if any
	my $credentials;
	if ($host =~ /^(.*)\@([^\@]*)$/) {
		$credentials = $1;
		$host = lc($2);
	} else {
		$host = lc($host);
	}

	# Remove default port
	if ($host =~ /^(.*):(\d+)$/) {
		$host = $1 if $protocol eq 'http' && $2 == 80;
		$host = $1 if $protocol eq 'https' && $2 == 443;
	}

	# Checks the path and warn the user if obvious things are likely to go wrong
	$o->{ui}->warning('Warning: "//" in URL may not work') if $path =~ /\/\//;
	$o->{ui}->warning('Warning: /./ or /../ in URL may not work') if $path =~ /\/\.+\//;
	$o->{ui}->warning('Warning: /. or /.. at the end of the URL may not work') if $path =~ /\/\.+$/;

	# Signature

	# Date
	my $dateString = CDS::ISODate->millisecondString(CDS->now);

	# Text to sign
	my $bytesToSign = $dateString."\0".uc($method)."\0".$host.$path;
	$bytesToSign .= "\0".$contentObjectToSign->header.$contentObjectToSign->data if defined $contentObjectToSign;

	# Signature
	my $keyPair = $o->{keyPairToken}->keyPair;
	my $hashToSign = CDS::Hash->calculateFor($bytesToSign);
	my $signature = $keyPair->signHash($hashToSign);
	push @$curlArgs, '-H', 'Condensation-Date: '.$dateString;
	push @$curlArgs, '-H', 'Condensation-Actor: '.$keyPair->publicKey->hash->hex;
	push @$curlArgs, '-H', 'Condensation-Signature: '.unpack('H*', $signature);

	# Write signature information to files
	CDS->writeBytesToFile('.cds-curl-bytesToSign', $bytesToSign) || $o->{ui}->warning('Unable to write the bytes to sign to ".cds-curl-bytesToSign".');
	CDS->writeBytesToFile('.cds-curl-hashToSign', $hashToSign->bytes) || $o->{ui}->warning('Unable to write the hash to sign to ".cds-curl-hashToSign".');
	CDS->writeBytesToFile('.cds-curl-signature', $signature) || $o->{ui}->warning('Unable to write signature to ".cds-curl-signature".');

	# Method
	unshift @$curlArgs, '-X', $method if $method ne 'GET';
	unshift @$curlArgs, '-#', '--dump-header', '-';

	# Print
	$o->{ui}->line($o->{ui}->gold('curl', join('', map { ($_ ne '-X' && $_ ne '-' && $_ ne '--dump-header' && $_ ne '-#' && substr($_, 0, 1) eq '-' ? " \\\n     " : ' ').&withQuotesIfNecessary($_) } @$curlArgs), scalar @$curlArgs ? " \\\n     " : ' ', &...

	# Execute
	system('curl', @$curlArgs, $url);
}

sub withQuotesIfNecessary {
	my $text = shift;

	return $text =~ /[^a-zA-Z0-9\.\/\@:,_-]/ ? '\''.$text.'\'' : $text;
}

# BEGIN AUTOGENERATED
package CDS::Commands::DiscoverActorGroup;

sub register {
	my $class = shift;