view release on metacpan or  search on metacpan

lib/CDS.pm  view on Meta::CPAN

	my $value = shift;

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

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

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

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

	$o->{permissions} = CDS::FolderStore::PosixPermissions::User->new($value);
}

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

# END AUTOGENERATED

# HTML FOLDER NAME folder-store
# HTML TITLE Folder store management
sub help {
	my $o = shift;
	my $cmd = shift;

	my $ui = $o->{ui};
	$ui->space;
	$ui->command('cds create store FOLDERNAME');
	$ui->p('Creates a new store in FOLDERNAME, and adds it to the list of known stores. If the folder does not exist, it is created. If it does exist, it must be empty.');
	$ui->space;
	$ui->p('By default, the filesystem permissions of the store are set such that only the current user can post objects and modify boxes. Other users on the system can post to the message box, list boxes, and read objects.');
	$ui->space;
	$ui->command('… for user USER');
	$ui->p('Makes the store accessible to the user USER.');
	$ui->space;
	$ui->command('… for group GROUP');
	$ui->p('Makes the store accessible to the group GROUP.');
	$ui->space;
	$ui->command('… for everybody');
	$ui->p('Makes the store accessible to everybody.');
	$ui->space;
	$ui->p('Note that the permissions only affect direct filesystem access. If your store is exposed by a server (e.g. a web server), it may be accessible to others.');
	$ui->space;
	$ui->command('… and remember it as TEXT');
	$ui->p('Remembers the store under the label TEXT. See "cds help remember" for details.');
	$ui->space;
	$ui->command('cds check permissions [of STORE]');
	$ui->p('Checks the permissions (owner, mode) of all accounts, boxes, box entries, and objects of the store, and reports any error. The permission scheme (user, group, or everybody) is derived from the "accounts" and "objects" folders.');
	$ui->p('If the store is omitted, the selected store is used.');
	$ui->space;
	$ui->command('cds fix permissions [of STORE]');
	$ui->p('Same as above, but tries to fix the permissions (chown, chmod) instead of just reporting them.');
	$ui->space;
	$ui->command('cds show permission scheme [of STORE]');
	$ui->p('Reports the permission scheme of the store.');
	$ui->space;
	$ui->command('cds set permission scheme [of STORE] to (user USER|group GROUP|everybody)');
	$ui->p('Sets the permission scheme of the stores, and changes all permissions accordingly.');
	$ui->space;
	$ui->command('cds add account ACCOUNT [to STORE]');
	$ui->command('cds add account for FILE [to STORE]');
	$ui->command('cds add account for KEYPAIR [to STORE]');
	$ui->command('cds add account for OBJECT [to STORE]');
	$ui->command('cds add account for ACTOR on STORE [to STORE]');
	$ui->p('Uploads the public key (FILE, KEYPAIR, OBJECT, ACCOUNT, or ACTOR on STORE) onto the store, and adds the corresponding account. This grants the user the right to access this account.');
	$ui->space;
	$ui->command('cds remove account HASH [from STORE]');
	$ui->p('Removes the indicated account from the store. This immediately destroys the user\'s data.');
	$ui->space;
}

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

	$o->{permissions} = CDS::FolderStore::PosixPermissions::User->new;
	$cmd->collect($o);

	# Give up if the folder is non-empty (but we accept hidden files)
	for my $file (CDS->listFolder($o->{foldername})) {
		next if $file =~ /^\./;
		$o->{ui}->pRed('The folder ', $o->{foldername}, ' is not empty. Giving up …');
		return;
	}

	# Create the object store
	$o->create($o->{foldername}.'/objects') // return;
	$o->{ui}->pGreen('Object store created for ', $o->{permissions}->target, '.');

	# Create the account store
	$o->create($o->{foldername}.'/accounts') // return;
	$o->{ui}->pGreen('Account store created for ', $o->{permissions}->target, '.');

	# Return if the user does not want us to add the store
	return if ! defined $o->{label};

	# Remember the store
	my $record = CDS::Record->new;
	$record->addText('store')->addText('file://'.$o->{foldername});
	$o->{actor}->remember($o->{label}, $record);
	$o->{actor}->saveOrShowError;
}

# Creates a folder with the selected permissions.
sub create {
	my $o = shift;
	my $folder = shift;

	# Create the folders to here if necessary
	for my $intermediateFolder (CDS->intermediateFolders($folder)) {
		mkdir $intermediateFolder, 0755;
	}

	# mkdir (if it does not exist yet) and chmod (if it does exist already)
	mkdir $folder, $o->{permissions}->baseFolderMode;
	chmod $o->{permissions}->baseFolderMode, $folder;
	chown $o->{permissions}->uid // -1, $o->{permissions}->gid // -1, $folder;

	# Check if the result is correct
	my @s = stat $folder;
	return $o->{ui}->error('Unable to create ', $o->{foldername}, '.') if ! scalar @s;
	my $mode = $s[2];
	return $o->{ui}->error($folder, ' exists, but is not a folder') if ! Fcntl::S_ISDIR($mode);
	return $o->{ui}->error('Unable to set the owning user ', $o->{permissions}->user, ' for ', $folder, '.') if defined $o->{permissions}->uid && $s[4] != $o->{permissions}->uid;
	return $o->{ui}->error('Unable to set the owning group ', $o->{permissions}->group, ' for ', $folder, '.') if defined $o->{permissions}->gid && $s[5] != $o->{permissions}->gid;
	return $o->{ui}->error('Unable to set the mode on ', $folder, '.') if ($mode & 0777) != $o->{permissions}->baseFolderMode;
	return 1;
}

sub existingFolderStoreOrShowError {
	my $o = shift;

	my $store = $o->{store} // $o->{actor}->preferredStore;

	my $folderStore = CDS::FolderStore->forUrl($store->url);
	if (! $folderStore) {
		$o->{ui}->error('"', $store->url, '" is not a folder store.');
		$o->{ui}->space;
		$o->{ui}->p('Account management and file system permission checks only apply to stores on the local file system. Such stores are referred to by file://… URLs, or file system paths.');
		$o->{ui}->p('To fix the permissions on a remote store, log onto that server and fix the permissions there. Note that permissions are not part of the Condensation protocol, but a property of some underlying storage systems, such as file systems.');
		$o->{ui}->space;
		return;
	}

	if (! $folderStore->exists) {
		$o->{ui}->error('"', $folderStore->folder, '" does not exist.');
		$o->{ui}->space;
		$o->{ui}->p('The folder either does not exist, or is not a folder store. You can create this store using:');
		$o->{ui}->line($o->{ui}->gold('  cds create store ', $folderStore->folder));
		$o->{ui}->space;
		return;
	}

	return $folderStore;
}

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

	$cmd->collect($o);
	my $folderStore = $o->existingFolderStoreOrShowError // return;
	$o->showStore($folderStore);
	$o->{ui}->space;
}

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

	$o->{ui}->space;
	$o->{ui}->title('Store');
	$o->{ui}->line($folderStore->folder);
	$o->{ui}->line('Accessible to ', $folderStore->permissions->target, '.');
}

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

	$cmd->collect($o);

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

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

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

sub checkPermissions {
	my $o = shift;
	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

lib/CDS.pm  view on Meta::CPAN

		for my $file (sort { $a cmp $b } CDS->listFolder($subFolder)) {
			next if $file !~ /^[0-9a-f]{62}/;
			$permissions->checkPermissions($subFolder.'/'.$file, $fileMode, $logger) || return;
		}
	}

	return 1;
}

# Handles POSIX permissions (user, group, and mode).
package CDS::FolderStore::PosixPermissions;

# Returns the permissions set corresponding to the mode, uid, and gid of the base folder.
# If the permissions are ambiguous, the more restrictive set is chosen.
sub forFolder {
	my $class = shift;
	my $folder = shift;

	my @s = stat $folder;
	my $mode = $s[2] // 0;

	return
		($mode & 077) == 077 ? CDS::FolderStore::PosixPermissions::World->new :
		($mode & 070) == 070 ? CDS::FolderStore::PosixPermissions::Group->new($s[5]) :
			CDS::FolderStore::PosixPermissions::User->new($s[4]);
}

sub uid { shift->{uid} }
sub gid { shift->{gid} }

sub user {
	my $o = shift;

	my $uid = $o->{uid} // return;
	return getpwuid($uid) // $uid;
}

sub group {
	my $o = shift;

	my $gid = $o->{gid} // return;
	return getgrgid($gid) // $gid;
}

sub writeTemporaryFile {
	my $o = shift;
	my $folder = shift;
	my $mode = shift;

	# Write the file
	my $temporaryFile = $folder.'/.'.CDS->randomHex(16);
	open(my $fh, '>:bytes', $temporaryFile) || return;
	print $fh @_;
	close $fh;

	# Set the permissions
	chmod $mode, $temporaryFile;
	my $uid = $o->uid;
	my $gid = $o->gid;
	chown $uid // -1, $gid // -1, $temporaryFile if defined $uid && $uid != $< || defined $gid && $gid != $(;
	return $temporaryFile;
}

sub mkdir {
	my $o = shift;
	my $folder = shift;
	my $mode = shift;

	return if -d $folder;

	# Create the folder (note: mode is altered by umask)
	my $success = mkdir $folder, $mode;

	# Set the permissions
	chmod $mode, $folder;
	my $uid = $o->uid;
	my $gid = $o->gid;
	chown $uid // -1, $gid // -1, $folder if defined $uid && $uid != $< || defined $gid && $gid != $(;
	return $success;
}

# Check the permissions of a file or folder, and fix them if desired.
# A logger object is called for the different cases (access error, correct permissions, wrong permissions, error fixing permissions).
sub checkPermissions {
	my $o = shift;
	my $item = shift;
	my $expectedMode = shift;
	my $logger = shift;

	my $expectedUid = $o->uid;
	my $expectedGid = $o->gid;

	# Stat the item
	my @s = stat $item;
	return $logger->accessError($item) if ! scalar @s;
	my $mode = $s[2] & 07777;
	my $uid = $s[4];
	my $gid = $s[5];

	# Check
	my $wrongUid = defined $expectedUid && $uid != $expectedUid;
	my $wrongGid = defined $expectedGid && $gid != $expectedGid;
	my $wrongMode = $mode != $expectedMode;
	if ($wrongUid || $wrongGid || $wrongMode) {
		# Something is wrong
		$logger->wrong($item, $uid, $gid, $mode, $expectedUid, $expectedGid, $expectedMode) || return 1;

		# Fix uid and gid
		if ($wrongUid || $wrongGid) {
			my $count = chown $expectedUid // -1, $expectedGid // -1, $item;
			return $logger->setError($item) if $count < 1;
		}

		# Fix mode
		if ($wrongMode) {
			my $count = chmod $expectedMode, $item;
			return $logger->setError($item) if $count < 1;
		}
	} else {
		# Everything is OK
		$logger->correct($item, $mode, $uid, $gid);
	}

	return 1;
}

# The store belongs to a group. Every user belonging to the group is treated equivalent, and users are supposed to trust each other to some extent.
# The resulting store will have files belonging to multiple users, but the same group.
package CDS::FolderStore::PosixPermissions::Group;

use parent -norequire, 'CDS::FolderStore::PosixPermissions';

sub new {
	my $class = shift;
	my $gid = shift;

	return bless {gid => $gid // $(};
}

sub target {
	my $o = shift;
	 'members of the group '.$o->group }
sub baseFolderMode { 0771 }
sub objectFolderMode { 0771 }
sub objectFileMode { 0664 }
sub accountFolderMode { 0771 }
sub boxFolderMode {
	my $o = shift;
	my $boxLabel = shift;
	 $boxLabel eq 'public' ? 0775 : 0770 }
sub boxFileMode {
	my $o = shift;
	my $boxLabel = shift;
	 $boxLabel eq 'public' ? 0664 : 0660 }

# The store belongs to a single user. Other users shall only be able to read objects and the public box, and post to the message box.
package CDS::FolderStore::PosixPermissions::User;

use parent -norequire, 'CDS::FolderStore::PosixPermissions';

sub new {
	my $class = shift;
	my $uid = shift;

	return bless {uid => $uid // $<};
}

sub target {
	my $o = shift;
	 'user '.$o->user }