CDS

 view release on metacpan or  search on metacpan

lib/CDS.pm  view on Meta::CPAN

	my $envelopeExpirationLimit = time * 1000;

	# Read the tree index
	$o->readIndex;

	# Process all accounts
	$o->{ui}->space;
	$o->{ui}->title($o->{ui}->left(64, 'Accounts'), '   ', $o->{ui}->right(10, 'messages'), ' ', $o->{ui}->right(10, 'private'), ' ', $o->{ui}->right(10, 'public'), '   ', 'last modification');
	$o->startProgress('linked objects');
	$o->{usedHashes} = {};
	$o->{missingObjects} = {};
	$o->{brokenOrigins} = {};
	my $countAccounts = 0;
	my $countKeptEnvelopes = 0;
	my $countDeletedEnvelopes = 0;
	for my $accountHash (sort { $$a cmp $$b } $folderStore->accounts) {
		# This would be the private key, but we don't use it right now
		$o->{usedHashes}->{$accountHash->hex} = 1;

		my $newestDate = 0;
		my %sizeByBox;
		my $accountFolder = $o->{accountsFolder}.'/'.$accountHash->hex;
		foreach my $boxLabel (CDS->listFolder($accountFolder)) {
			next if $boxLabel =~ /^\./;
			my $boxFolder = $accountFolder.'/'.$boxLabel;
			my $date = &lastModified($boxFolder);
			$newestDate = $date if $newestDate < $date;
			my $size = 0;
			foreach my $filename (CDS->listFolder($boxFolder)) {
				next if $filename =~ /^\./;
				my $hash = pack('H*', $filename);
				my $file = $boxFolder.'/'.$filename;

				my $timestamp = $o->envelopeExpiration($hash, $boxFolder);
				if ($timestamp > 0 && $timestamp < $envelopeExpirationLimit) {
					$countDeletedEnvelopes += 1;
					$handler->deleteEnvelope($file) // return;
					next;
				}

				$countKeptEnvelopes += 1;
				my $date = &lastModified($file);
				$newestDate = $date if $newestDate < $date;
				$size += $o->traverse($hash, $boxFolder);
			}
			$sizeByBox{$boxLabel} = $size;
		}

		$o->{ui}->line($accountHash->hex, '   ',
			$o->{ui}->right(10, $o->{ui}->niceFileSize($sizeByBox{'messages'} || 0)), ' ',
			$o->{ui}->right(10, $o->{ui}->niceFileSize($sizeByBox{'private'} || 0)), ' ',
			$o->{ui}->right(10, $o->{ui}->niceFileSize($sizeByBox{'public'} || 0)), '   ',
			$newestDate == 0 ? 'never' : $o->{ui}->niceDateTime($newestDate * 1000));

		$countAccounts += 1;
	}

	$o->{ui}->line($countAccounts, ' accounts traversed');
	$o->{ui}->space;

	# Mark all objects that are younger than 1 day (so that objects being uploaded right now but not linked yet remain)
	$o->{ui}->title('Objects');
	$o->startProgress('objects');

	my %objects;
	my @topFolders = sort grep {$_ !~ /^\./} CDS->listFolder($o->{objectsFolder});
	foreach my $topFolder (@topFolders) {
		my @files = sort grep {$_ !~ /^\./} CDS->listFolder($o->{objectsFolder}.'/'.$topFolder);
		foreach my $filename (@files) {
			$o->incrementProgress;
			my $hash = pack 'H*', $topFolder.$filename;
			my @s = stat $o->{objectsFolder}.'/'.$topFolder.'/'.$filename;
			$objects{$hash} = $s[7];
			next if $s[9] < $dateLimit;
			$o->traverse($hash, 'recent object');
		}
	}

	$o->{ui}->line(scalar keys %objects, ' objects traversed');
	$o->{ui}->space;

	# Delete all unmarked objects, and add the marked objects to the new tree index
	my $index = CDS::Record->new;
	my $countKeptObjects = 0;
	my $sizeKeptObjects = 0;
	my $countDeletedObjects = 0;
	my $sizeDeletedObjects = 0;

	$handler->startDeletion;
	$o->startProgress('delete-objects');
	for my $hash (keys %objects) {
		my $size = $objects{$hash};
		if (exists $o->{usedHashes}->{$hash}) {
			$countKeptObjects += 1;
			$sizeKeptObjects += $size;
			my $entry = $o->{index}->{$hash};
			$index->addRecord($entry) if $entry;
		} else {
			$o->incrementProgress;
			$countDeletedObjects += 1;
			$sizeDeletedObjects += $size;
			my $hashHex = unpack 'H*', $hash;
			my $file = $o->{objectsFolder}.'/'.substr($hashHex, 0, 2).'/'.substr($hashHex, 2);
			$handler->deleteObject($file) // return;
		}
	}

	# Write the new tree index
	CDS->writeBytesToFile($o->{storeFolder}.'/.index-new', $index->toObject->bytes);
	rename $o->{storeFolder}.'/.index-new', $o->{storeFolder}.'/.index';

	# Show what has been done
	$o->{ui}->space;
	$o->{ui}->line($countDeletedEnvelopes, ' ', $handler->{deletedEnvelopesText});
	$o->{ui}->line($countKeptEnvelopes, ' ', $handler->{keptEnvelopesText});
	my $line1 = $countDeletedObjects.' '.$handler->{deletedObjectsText};
	my $line2 = $countKeptObjects.' '.$handler->{keptObjectsText};
	my $maxLength = CDS->max(length $line1, length $line2);
	$o->{ui}->line($o->{ui}->left($maxLength, $line1), '  ', $o->{ui}->gray($o->{ui}->niceFileSize($sizeDeletedObjects)));
	$o->{ui}->line($o->{ui}->left($maxLength, $line2), '  ', $o->{ui}->gray($o->{ui}->niceFileSize($sizeKeptObjects)));
	$o->{ui}->space;

lib/CDS.pm  view on Meta::CPAN

	my $cmd = shift;

	$cmd->collect($o);

	my $folderStore = $o->existingFolderStoreOrShowError // return;
	$o->showStore($folderStore);

	$o->{ui}->line('Checking permissions …');
	my $logger = CDS::Commands::FolderStore::CheckLogger->new($o, $folderStore->folder);
	$folderStore->checkPermissions($logger) || $o->traversalFailed($folderStore);
	$logger->summary;

	$o->{ui}->space;
}

sub fixPermissions {
	my $o = shift;
	my $cmd = shift;

	$cmd->collect($o);

	my $folderStore = $o->existingFolderStoreOrShowError // return;
	$o->showStore($folderStore);

	$o->{ui}->line('Fixing permissions …');
	my $logger = CDS::Commands::FolderStore::FixLogger->new($o, $folderStore->folder);
	$folderStore->checkPermissions($logger) || $o->traversalFailed($folderStore);
	$logger->summary;

	$o->{ui}->space;
}

sub traversalFailed {
	my $o = shift;
	my $folderStore = shift;

	$o->{ui}->space;
	$o->{ui}->p('Traversal failed because a file or folder could not be accessed. You may have to fix the permissions manually, or run this command with other privileges.');
	$o->{ui}->p('If you have root privileges, you can take over this store using:');
	my $userName = getpwuid($<);
	my $groupName = getgrgid($();
	$o->{ui}->line($o->{ui}->gold('  sudo chown -R ', $userName, ':', $groupName, ' ', $folderStore->folder));
	$o->{ui}->p('and then set the desired permission scheme:');
	$o->{ui}->line($o->{ui}->gold('  cds set permissions of ', $folderStore->folder, ' to …'));
	$o->{ui}->space;
	exit(1);
}

sub addAccount {
	my $o = shift;
	my $cmd = shift;

	$cmd->collect($o);

	# Prepare
	my $folderStore = $o->existingFolderStoreOrShowError // return;
	my $publicKey = $o->publicKey // return;

	# Upload the public key onto the store
	my $error = $folderStore->put($publicKey->hash, $publicKey->object);
	return $o->{ui}->error('Unable to upload the public key: ', $error) if $error;

	# Create the account folder
	my $folder = $folderStore->folder.'/accounts/'.$publicKey->hash->hex;
	my $permissions = $folderStore->permissions;
	$permissions->mkdir($folder, $permissions->accountFolderMode);
	return $o->{ui}->error('Unable to create folder "', $folder, '".') if ! -d $folder;
	$o->{ui}->pGreen('Account ', $publicKey->hash->hex, ' added.');
	return 1;
}

sub publicKey {
	my $o = shift;

	return $o->{keyPairToken}->keyPair->publicKey if $o->{keyPairToken};

	if ($o->{file}) {
		my $bytes = CDS->readBytesFromFile($o->{file}) // return $o->{ui}->error('Cannot read "', $o->{file}, '".');
		my $object = CDS::Object->fromBytes($bytes) // return $o->{ui}->error('"', $o->{file}, '" is not a public key.');
		return CDS::PublicKey->fromObject($object) // return $o->{ui}->error('"', $o->{file}, '" is not a public key.');
	}

	return $o->{actor}->uiGetPublicKey($o->{accountToken}->actorHash, $o->{accountToken}->cliStore, $o->{actor}->preferredKeyPairToken);
}

sub removeAccount {
	my $o = shift;
	my $cmd = shift;

	$cmd->collect($o);

	# Prepare the folder
	my $folderStore = $o->existingFolderStoreOrShowError // return;
	my $folder = $folderStore->folder.'/accounts/'.$o->{hash}->hex;
	my $deletedFolder = $folderStore->folder.'/accounts/deleted-'.$o->{hash}->hex;

	# Rename, so that it is not visible any more
	$o->recursivelyDelete($deletedFolder) if -e $deletedFolder;
	return $o->{ui}->line('The account ', $o->{hash}->hex, ' does not exist.') if ! -e $folder;
	rename($folder, $deletedFolder) || return $o->{ui}->error('Unable to rename the folder "', $folder, '".');

	# Try to delete it entirely
	$o->recursivelyDelete($deletedFolder);
	$o->{ui}->pGreen('Account ', $o->{hash}->hex, ' removed.');
	return 1;
}

sub recursivelyDelete {
	my $o = shift;
	my $folder = shift;

	for my $filename (CDS->listFolder($folder)) {
		next if $filename =~ /^\./;
		my $file = $folder.'/'.$filename;
		if (-f $file) {
			unlink $file || $o->{ui}->pOrange('Unable to remove the file "', $file, '".');
		} elsif (-d $file) {
			$o->recursivelyDelete($file);
		}
	}

lib/CDS.pm  view on Meta::CPAN

	$o->{aesKey} = $value;
}

sub collectFile {
	my $o = shift;
	my $label = shift;
	my $value = shift;

	$o->{dataFile} = $value;
}

sub collectHash {
	my $o = shift;
	my $label = shift;
	my $value = shift;

	push @{$o->{hashes}}, $value;
}

sub collectKeypair {
	my $o = shift;
	my $label = shift;
	my $value = shift;

	$o->{object} = $value->keyPair->publicKey->object;
}

sub collectObjectfile {
	my $o = shift;
	my $label = shift;
	my $value = shift;

	$o->{objectFile} = $value;
}

sub collectStore {
	my $o = shift;
	my $label = shift;
	my $value = shift;

	push @{$o->{stores}}, $value;
}

sub new {
	my $class = shift;
	my $actor = shift;
	 bless {actor => $actor, ui => $actor->ui} }

# END AUTOGENERATED

# HTML FOLDER NAME store-put
# HTML TITLE Put
sub help {
	my $o = shift;
	my $cmd = shift;

	my $ui = $o->{ui};
	$ui->space;
	$ui->command('cds put FILE* [onto STORE*]');
	$ui->p('Uploads object files onto object stores. If no stores are provided, the selected store is used. If an upload fails, the program immediately quits with exit code 1.');
	$ui->space;
	$ui->command('cds put FILE encrypted with AESKEY [onto STORE*]');
	$ui->p('Encrypts the object before the upload.');
	$ui->space;
	$ui->command('cds put object with [HASH* and] FILE …');
	$ui->p('Creates an object with the HASHes as hash list and FILE as data.');
	$ui->space;
	$ui->command('cds put public key of KEYPAIR …');
	$ui->p('Uploads the public key of the indicated key pair onto the store.');
	$ui->space;
}

sub put {
	my $o = shift;
	my $cmd = shift;

	$o->{hashes} = [];
	$o->{stores} = [];
	$cmd->collect($o);

	# Stores
	push @{$o->{stores}}, $o->{actor}->preferredStore if ! scalar @{$o->{stores}};

	$o->{get} = [];
	return $o->putObject($o->{object}) if $o->{object};
	return $o->putObjectFile if $o->{objectFile};
	$o->putConstructedFile;
}

sub putObjectFile {
	my $o = shift;

	my $object = $o->{objectFile}->object;

	# Display object information
	$o->{ui}->space;
	$o->{ui}->title('Uploading ', $o->{objectFile}->file, '  ', $o->{ui}->gray($o->{ui}->niceFileSize($object->byteLength)));
	$o->{ui}->line($object->hashesCount == 1 ? '1 hash' : $object->hashesCount.' hashes');
	$o->{ui}->line($o->{ui}->niceFileSize(length $object->data).' data');
	$o->{ui}->space;

	# Upload
	$o->putObject($object);
}

sub putConstructedFile {
	my $o = shift;

	# Create the object
	my $data = CDS->readBytesFromFile($o->{dataFile}) // return $o->{ui}->error('Unable to read "', $o->{dataFile}, '".');
	my $header = pack('L>', scalar @{$o->{hashes}}) . join('', map { $_->bytes } @{$o->{hashes}});
	my $object = CDS::Object->create($header, $data);

	# Display object information
	$o->{ui}->space;
	$o->{ui}->title('Uploading new object  ', $o->{ui}->gray($o->{ui}->niceFileSize(length $object->bytes)));
	$o->{ui}->line($object->hashesCount == 1 ? '1 hash' : $object->hashesCount.' hashes');
	$o->{ui}->line($o->{ui}->niceFileSize(length $object->data).' data from ', $o->{dataFile});
	$o->{ui}->space;

	# Upload
	$o->putObject($object);
}

sub putObject {
	my $o = shift;
	my $object = shift; die 'wrong type '.ref($object).' for $object' if defined $object && ref $object ne 'CDS::Object';

	my $keyPair = $o->{actor}->preferredKeyPairToken->keyPair;

	# Encrypt it if desired
	my $objectBytes;
	if (defined $o->{aesKey}) {
		$object = $object->crypt($o->{aesKey});
		unshift @{$o->{get}}, ' decrypted with ', unpack('H*', $o->{aesKey}), ' ';
	}

	# Calculate the hash
	my $hash = $object->calculateHash;

	# Upload the object
	my $successfulStore;
	for my $store (@{$o->{stores}}) {
		my $error = $store->put($hash, $object, $keyPair);
		next if $error;
		$o->{ui}->pGreen('The object was uploaded onto ', $store->url, '.');
		$successfulStore = $store;
	}

	# Show the corresponding download line
	return if ! $successfulStore;
	$o->{ui}->space;
	$o->{ui}->line('To download the object, type:');
	$o->{ui}->line($o->{ui}->gold('cds get ', $hash->hex), $o->{ui}->gray(' on ', $successfulStore->url, @{$o->{get}}));
	$o->{ui}->space;
}

package CDS::Commands::Remember;

# BEGIN AUTOGENERATED

sub register {
	my $class = shift;
	my $cds = shift;
	my $help = shift;

	my $node000 = CDS::Parser::Node->new(0, {constructor => \&new, function => \&showLabels});
	my $node001 = CDS::Parser::Node->new(0);
	my $node002 = CDS::Parser::Node->new(0);
	my $node003 = CDS::Parser::Node->new(1, {constructor => \&new, function => \&help});
	my $node004 = CDS::Parser::Node->new(0);
	my $node005 = CDS::Parser::Node->new(0);
	my $node006 = CDS::Parser::Node->new(1, {constructor => \&new, function => \&forget});
	my $node007 = CDS::Parser::Node->new(1);
	my $node008 = CDS::Parser::Node->new(0);
	my $node009 = CDS::Parser::Node->new(1, {constructor => \&new, function => \&remember});
	$cds->addArrow($node000, 1, 0, 'remember');
	$cds->addArrow($node001, 1, 0, 'forget');
	$help->addArrow($node003, 1, 0, 'forget');
	$help->addArrow($node003, 1, 0, 'remember');
	$node000->addArrow($node004, 1, 0, 'ACTOR', \&collectActor);
	$node000->addArrow($node007, 1, 1, 'ACCOUNT', \&collectAccount);
	$node000->addArrow($node007, 1, 0, 'ACTOR', \&collectActor);
	$node000->addArrow($node007, 1, 0, 'KEYPAIR', \&collectKeypair);
	$node000->addArrow($node007, 1, 0, 'STORE', \&collectStore);
	$node001->addDefault($node002);
	$node002->addArrow($node002, 1, 0, 'LABEL', \&collectLabel);
	$node002->addArrow($node006, 1, 0, 'LABEL', \&collectLabel);
	$node004->addArrow($node005, 1, 0, 'on');
	$node005->addArrow($node007, 1, 0, 'STORE', \&collectStore);
	$node007->addArrow($node008, 1, 0, 'as');
	$node008->addArrow($node009, 1, 0, 'TEXT', \&collectText);
}

sub collectAccount {
	my $o = shift;
	my $label = shift;
	my $value = shift;

	$o->{store} = $value->cliStore;
	$o->{actorHash} = $value->actorHash;
}

sub collectActor {
	my $o = shift;
	my $label = shift;