[pve-storage.git] / PVE / Storage / PBSPlugin.pm

package PVE::Storage::PBSPlugin;

# Plugin to access Proxmox Backup Server

use strict;
use warnings;

use Fcntl qw(F_GETFD F_SETFD FD_CLOEXEC);
use HTTP::Request;
use IO::File;
use JSON;
use LWP::UserAgent;
use POSIX qw(strftime ENOENT);

use PVE::JSONSchema qw(get_standard_option);
use PVE::Network;
use PVE::Storage::Plugin;
use PVE::Tools qw(run_command file_read_firstline trim dir_glob_regex dir_glob_foreach $IPV6RE);

use base qw(PVE::Storage::Plugin);

# Configuration

sub type {
    return 'pbs';
}

sub plugindata {
    return {
	content => [ {backup => 1, none => 1}, { backup => 1 }],
    };
}

sub properties {
    return {
	datastore => {
	    description => "Proxmox Backup Server datastore name.",
	    type => 'string',
	},
	# openssl s_client -connect <host>:8007 2>&1 |openssl x509 -fingerprint -sha256
	fingerprint => get_standard_option('fingerprint-sha256'),
	'encryption-key' => {
	    description => "Encryption key. Use 'autogen' to generate one automatically without passphrase.",
	    type => 'string',
	},
	port => {
	    description => "For non default port.",
	    type => 'integer',
	    minimum => 1,
	    maximum => 65535,
	    default => 8007,
	}
    };
}

sub options {
    return {
	server => { fixed => 1 },
	datastore => { fixed => 1 },
	port => { optional => 1 },
	nodes => { optional => 1},
	disable => { optional => 1},
	content => { optional => 1},
	username => { optional => 1 },
	password => { optional => 1 },
	'encryption-key' => { optional => 1 },
	maxfiles => { optional => 1 },
	'prune-backups' => { optional => 1 },
	fingerprint => { optional => 1 },
    };
}

# Helpers

sub pbs_password_file_name {
    my ($scfg, $storeid) = @_;

    return "/etc/pve/priv/storage/${storeid}.pw";
}

sub pbs_set_password {
    my ($scfg, $storeid, $password) = @_;

    my $pwfile = pbs_password_file_name($scfg, $storeid);
    mkdir "/etc/pve/priv/storage";

    PVE::Tools::file_set_contents($pwfile, "$password\n");
}

sub pbs_delete_password {
    my ($scfg, $storeid) = @_;

    my $pwfile = pbs_password_file_name($scfg, $storeid);

    unlink $pwfile;
}

sub pbs_get_password {
    my ($scfg, $storeid) = @_;

    my $pwfile = pbs_password_file_name($scfg, $storeid);

    return PVE::Tools::file_read_firstline($pwfile);
}

sub pbs_encryption_key_file_name {
    my ($scfg, $storeid) = @_;

    return "/etc/pve/priv/storage/${storeid}.enc";
}

sub pbs_set_encryption_key {
    my ($scfg, $storeid, $key) = @_;

    my $pwfile = pbs_encryption_key_file_name($scfg, $storeid);
    mkdir "/etc/pve/priv/storage";

    PVE::Tools::file_set_contents($pwfile, "$key\n");
}

sub pbs_delete_encryption_key {
    my ($scfg, $storeid) = @_;

    my $pwfile = pbs_encryption_key_file_name($scfg, $storeid);

    if (!unlink $pwfile) {
	return if $! == ENOENT;
	die "failed to delete encryption key! $!\n";
    }
    delete $scfg->{'encryption-key'};
}

sub pbs_get_encryption_key {
    my ($scfg, $storeid) = @_;

    my $pwfile = pbs_encryption_key_file_name($scfg, $storeid);

    return PVE::Tools::file_get_contents($pwfile);
}

# Returns a file handle if there is an encryption key, or `undef` if there is not. Dies on error.
sub pbs_open_encryption_key {
    my ($scfg, $storeid) = @_;

    my $encryption_key_file = pbs_encryption_key_file_name($scfg, $storeid);

    my $keyfd;
    if (!open($keyfd, '<', $encryption_key_file)) {
	return undef if $! == ENOENT;
	die "failed to open encryption key: $encryption_key_file: $!\n";
    }

    return $keyfd;
}

sub print_volid {
    my ($storeid, $btype, $bid, $btime) = @_;

    my $time_str = strftime("%FT%TZ", gmtime($btime));
    my $volname = "backup/${btype}/${bid}/${time_str}";

    return "${storeid}:${volname}";
}

my sub get_server_with_port {
    my ($scfg) = @_;

    my $server = $scfg->{server};
    $server = "[$server]" if $server =~ /^$IPV6RE$/;

    if (my $port = $scfg->{port}) {
	$server .= ":$port" if $port != 8007;
    }
    return $server;
}

my $USE_CRYPT_PARAMS = {
    backup => 1,
    restore => 1,
    'upload-log' => 1,
};

my sub do_raw_client_cmd {
    my ($scfg, $storeid, $client_cmd, $param, %opts) = @_;

    my $use_crypto = $USE_CRYPT_PARAMS->{$client_cmd};

    my $client_exe = '/usr/bin/proxmox-backup-client';
    die "executable not found '$client_exe'! Proxmox backup client not installed?\n"
	if ! -x $client_exe;

    my $server = get_server_with_port($scfg);
    my $datastore = $scfg->{datastore};
    my $username = $scfg->{username} // 'root@pam';

    my $userns_cmd = delete $opts{userns_cmd};

    my $cmd = [];

    push @$cmd, @$userns_cmd if defined($userns_cmd);

    push @$cmd, $client_exe, $client_cmd;

    # This must live in the top scope to not get closed before the `run_command`
    my $keyfd;
    if ($use_crypto) {
	if (defined($keyfd = pbs_open_encryption_key($scfg, $storeid))) {
	    my $flags = fcntl($keyfd, F_GETFD, 0)
		// die "failed to get file descriptor flags: $!\n";
	    fcntl($keyfd, F_SETFD, $flags & ~FD_CLOEXEC)
		or die "failed to remove FD_CLOEXEC from encryption key file descriptor\n";
	    push @$cmd, '--crypt-mode=encrypt', '--keyfd='.fileno($keyfd);
	} else {
	    push @$cmd, '--crypt-mode=none';
	}
    }

    push @$cmd, @$param if defined($param);

    push @$cmd, "--repository", "$username\@$server:$datastore";

    local $ENV{PBS_PASSWORD} = pbs_get_password($scfg, $storeid);

    local $ENV{PBS_FINGERPRINT} = $scfg->{fingerprint};

    # no ascii-art on task logs
    local $ENV{PROXMOX_OUTPUT_NO_BORDER} = 1;
    local $ENV{PROXMOX_OUTPUT_NO_HEADER} = 1;

    if (my $logfunc = $opts{logfunc}) {
	$logfunc->("run: " . join(' ', @$cmd));
    }

    run_command($cmd, %opts);
}

# FIXME: External perl code should NOT have access to this.
#
# There should be separate functions to
# - make backups
# - restore backups
# - restore files
# with a sane API
sub run_raw_client_cmd {
    my ($scfg, $storeid, $client_cmd, $param, %opts) = @_;
    return do_raw_client_cmd($scfg, $storeid, $client_cmd, $param, %opts);
}

sub run_client_cmd {
    my ($scfg, $storeid, $client_cmd, $param, $no_output) = @_;

    my $json_str = '';
    my $outfunc = sub { $json_str .= "$_[0]\n" };

    $param = [] if !defined($param);
    $param = [ $param ] if !ref($param);

    $param = [@$param, '--output-format=json'] if !$no_output;

    do_raw_client_cmd($scfg, $storeid, $client_cmd, $param,
		      outfunc => $outfunc, errmsg => 'proxmox-backup-client failed');

    return undef if $no_output;

    my $res = decode_json($json_str);

    return $res;
}

# Storage implementation

sub extract_vzdump_config {
    my ($class, $scfg, $volname, $storeid) = @_;

    my ($vtype, $name, $vmid, undef, undef, undef, $format) = $class->parse_volname($volname);

    my $config = '';
    my $outfunc = sub { $config .= "$_[0]\n" };

    my $config_name;
    if ($format eq 'pbs-vm') {
	$config_name = 'qemu-server.conf';
    } elsif  ($format eq 'pbs-ct') {
	$config_name = 'pct.conf';
    } else {
	die "unable to extract configuration for backup format '$format'\n";
    }

    do_raw_client_cmd($scfg, $storeid, 'restore', [ $name, $config_name, '-' ],
		      outfunc => $outfunc, errmsg => 'proxmox-backup-client failed');

    return $config;
}

sub prune_backups {
    my ($class, $scfg, $storeid, $keep, $vmid, $type, $dryrun, $logfunc) = @_;

    $logfunc //= sub { print "$_[1]\n" };

    my $backups = $class->list_volumes($storeid, $scfg, $vmid, ['backup']);

    $type = 'vm' if defined($type) && $type eq 'qemu';
    $type = 'ct' if defined($type) && $type eq 'lxc';

    my $backup_groups = {};
    foreach my $backup (@{$backups}) {
	(my $backup_type = $backup->{format}) =~ s/^pbs-//;

	next if defined($type) && $backup_type ne $type;

	my $backup_group = "$backup_type/$backup->{vmid}";
	$backup_groups->{$backup_group} = 1;
    }

    my @param;
    foreach my $opt (keys %{$keep}) {
	push @param, "--$opt";
	push @param, "$keep->{$opt}";
    }

    push @param, '--dry-run' if $dryrun;

    my $prune_list = [];
    my $failed;

    foreach my $backup_group (keys %{$backup_groups}) {
	$logfunc->('info', "running 'proxmox-backup-client prune' for '$backup_group'")
	    if !$dryrun;
	eval {
	    my $res = run_client_cmd($scfg, $storeid, 'prune', [ $backup_group, @param ]);

	    foreach my $backup (@{$res}) {
		die "result from proxmox-backup-client is not as expected\n"
		    if !defined($backup->{'backup-time'})
		    || !defined($backup->{'backup-type'})
		    || !defined($backup->{'backup-id'})
		    || !defined($backup->{'keep'});

		my $ctime = $backup->{'backup-time'};
		my $type = $backup->{'backup-type'};
		my $vmid = $backup->{'backup-id'};
		my $volid = print_volid($storeid, $type, $vmid, $ctime);

		push @{$prune_list}, {
		    ctime => $ctime,
		    mark => $backup->{keep} ? 'keep' : 'remove',
		    type => $type eq 'vm' ? 'qemu' : 'lxc',
		    vmid => $vmid,
		    volid => $volid,
		};
	    }
	};
	if (my $err = $@) {
	    $logfunc->('err', "prune '$backup_group': $err\n");
	    $failed = 1;
	}
    }
    die "error pruning backups - check log\n" if $failed;

    return $prune_list;
}

my $autogen_encryption_key = sub {
    my ($scfg, $storeid) = @_;
    my $encfile = pbs_encryption_key_file_name($scfg, $storeid);
    my $cmd = ['proxmox-backup-client', 'key', 'create', '--kdf', 'none', $encfile];
    run_command($cmd, errmsg => 'failed to create encryption key');
    return PVE::Tools::file_get_contents($encfile);
};

sub on_add_hook {
    my ($class, $storeid, $scfg, %param) = @_;

    my $res = {};

    if (defined(my $password = $param{password})) {
	pbs_set_password($scfg, $storeid, $password);
    } else {
	pbs_delete_password($scfg, $storeid);
    }

    if (defined(my $encryption_key = $param{'encryption-key'})) {
	if ($encryption_key eq 'autogen') {
	    $res->{'encryption-key'} = $autogen_encryption_key->($scfg, $storeid);
	} else {
	    pbs_set_encryption_key($scfg, $storeid, $encryption_key);
	    $res->{'encryption-key'} = $encryption_key;
	}
	$scfg->{'encryption-key'} = 1;
    } else {
	pbs_delete_encryption_key($scfg, $storeid);
    }

    return $res;
}

sub on_update_hook {
    my ($class, $storeid, $scfg, %param) = @_;

    my $res = {};

    if (exists($param{password})) {
	if (defined($param{password})) {
	    pbs_set_password($scfg, $storeid, $param{password});
	} else {
	    pbs_delete_password($scfg, $storeid);
	}
    }

    if (exists($param{'encryption-key'})) {
	if (defined(my $encryption_key = delete($param{'encryption-key'}))) {
	    if ($encryption_key eq 'autogen') {
		$res->{'encryption-key'} = $autogen_encryption_key->($scfg, $storeid);
	    } else {
		pbs_set_encryption_key($scfg, $storeid, $encryption_key);
		$res->{'encryption-key'} = $encryption_key;
	    }
	    $scfg->{'encryption-key'} = 1;
	} else {
	    pbs_delete_encryption_key($scfg, $storeid);
	}
    }

    return $res;
}

sub on_delete_hook {
    my ($class, $storeid, $scfg) = @_;

    pbs_delete_password($scfg, $storeid);
    pbs_delete_encryption_key($scfg, $storeid);
}

sub parse_volname {
    my ($class, $volname) = @_;

    if ($volname =~ m!^backup/([^\s_]+)/([^\s_]+)/([0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}Z)$!) {
	my $btype = $1;
	my $bid = $2;
	my $btime = $3;
	my $format = "pbs-$btype";

	my $name = "$btype/$bid/$btime";

	if ($bid =~ m/^\d+$/) {
	    return ('backup', $name, $bid, undef, undef, undef, $format);
	} else {
	    return ('backup', $name, undef, undef, undef, undef, $format);
	}
    }

    die "unable to parse PBS volume name '$volname'\n";
}

sub path {
    my ($class, $scfg, $volname, $storeid, $snapname) = @_;

    die "volume snapshot is not possible on pbs storage"
	if defined($snapname);

    my ($vtype, $name, $vmid) = $class->parse_volname($volname);

    my $server = get_server_with_port($scfg);
    my $datastore = $scfg->{datastore};
    my $username = $scfg->{username} // 'root@pam';

    # artifical url - we currently do not use that anywhere
    my $path = "pbs://$username\@$server:$datastore/$name";

    return ($path, $vmid, $vtype);
}

sub create_base {
    my ($class, $storeid, $scfg, $volname) = @_;

    die "can't create base images in pbs storage\n";
}

sub clone_image {
    my ($class, $scfg, $storeid, $volname, $vmid, $snap) = @_;

    die "can't clone images in pbs storage\n";
}

sub alloc_image {
    my ($class, $storeid, $scfg, $vmid, $fmt, $name, $size) = @_;

    die "can't allocate space in pbs storage\n";
}

sub free_image {
    my ($class, $storeid, $scfg, $volname, $isBase) = @_;

    my ($vtype, $name, $vmid) = $class->parse_volname($volname);

    run_client_cmd($scfg, $storeid, "forget", [ $name ], 1);
}


sub list_images {
    my ($class, $storeid, $scfg, $vmid, $vollist, $cache) = @_;

    my $res = [];

    return $res;
}

sub list_volumes {
    my ($class, $storeid, $scfg, $vmid, $content_types) = @_;

    my $res = [];

    return $res if !grep { $_ eq 'backup' } @$content_types;

    my $data = run_client_cmd($scfg, $storeid, "snapshots");

    foreach my $item (@$data) {
	my $btype = $item->{"backup-type"};
	my $bid = $item->{"backup-id"};
	my $epoch = $item->{"backup-time"};
	my $size = $item->{size} // 1;

	next if !($btype eq 'vm' || $btype eq 'ct');
	next if $bid !~ m/^\d+$/;
	next if defined($vmid) && $bid ne $vmid;

	my $volid = print_volid($storeid, $btype, $bid, $epoch);

	my $info = {
	    volid => $volid,
	    format => "pbs-$btype",
	    size => $size,
	    content => 'backup',
	    vmid => int($bid),
	    ctime => $epoch,
	};

	$info->{verification} = $item->{verification} if defined($item->{verification});
	$info->{comment} = $item->{comment} if defined($item->{comment});

	push @$res, $info;
    }

    return $res;
}

sub status {
    my ($class, $storeid, $scfg, $cache) = @_;

    my $total = 0;
    my $free = 0;
    my $used = 0;
    my $active = 0;

    eval {
	my $res = run_client_cmd($scfg, $storeid, "status");

	$active = 1;
	$total = $res->{total};
	$used = $res->{used};
	$free = $res->{avail};
    };
    if (my $err = $@) {
	warn $err;
    }

    return ($total, $free, $used, $active);
}

sub activate_storage {
    my ($class, $storeid, $scfg, $cache) = @_;

    # a 'status' client command is to expensive here
    # TODO: use a dummy ping API call to ensure the PBS API daemon is available for real
    my $server = $scfg->{server};
    my $port = $scfg->{port} // 8007;
    PVE::Network::tcp_ping($server, $port, 2);

    return 1;
}

sub deactivate_storage {
    my ($class, $storeid, $scfg, $cache) = @_;
    return 1;
}

sub activate_volume {
    my ($class, $storeid, $scfg, $volname, $snapname, $cache) = @_;

    die "volume snapshot is not possible on pbs device" if $snapname;

    return 1;
}

sub deactivate_volume {
    my ($class, $storeid, $scfg, $volname, $snapname, $cache) = @_;

    die "volume snapshot is not possible on pbs device" if $snapname;

    return 1;
}

sub volume_size_info {
    my ($class, $scfg, $storeid, $volname, $timeout) = @_;

    my ($vtype, $name,  undef, undef, undef, undef, $format) = $class->parse_volname($volname);

    my $data = run_client_cmd($scfg, $storeid, "files", [ $name ]);

    my $size = 0;
    foreach my $info (@$data) {
	$size += $info->{size} if $info->{size};
    }

    my $used = $size;

    return wantarray ? ($size, $format, $used, undef) : $size;
}

sub volume_resize {
    my ($class, $scfg, $storeid, $volname, $size, $running) = @_;
    die "volume resize is not possible on pbs device";
}

sub volume_snapshot {
    my ($class, $scfg, $storeid, $volname, $snap) = @_;
    die "volume snapshot is not possible on pbs device";
}

sub volume_snapshot_rollback {
    my ($class, $scfg, $storeid, $volname, $snap) = @_;
    die "volume snapshot rollback is not possible on pbs device";
}

sub volume_snapshot_delete {
    my ($class, $scfg, $storeid, $volname, $snap) = @_;
    die "volume snapshot delete is not possible on pbs device";
}

sub volume_has_feature {
    my ($class, $scfg, $feature, $storeid, $volname, $snapname, $running) = @_;

    return undef;
}

1;
Commit	Line	Data
271fe394 DM	1	package PVE::Storage::PBSPlugin;
	2
	3	# Plugin to access Proxmox Backup Server
	4
	5	use strict;
	6	use warnings;
4133e6e2	7
76bb5feb	8	use Fcntl qw(F_GETFD F_SETFD FD_CLOEXEC);
271fe394	9	use HTTP::Request;
76bb5feb	10	use IO::File;
271fe394	11	use JSON;
76bb5feb WB	12	use LWP::UserAgent;
76bb5feb WB	13	use POSIX qw(strftime ENOENT);
271fe394	14
271fe394	15	use PVE::JSONSchema qw(get_standard_option);
4133e6e2 TL	16	use PVE::Network;
	17	use PVE::Storage::Plugin;
	18	use PVE::Tools qw(run_command file_read_firstline trim dir_glob_regex dir_glob_foreach $IPV6RE);
271fe394 DM	19
	20	use base qw(PVE::Storage::Plugin);
	21
	22	# Configuration
	23
	24	sub type {
	25	return 'pbs';
	26	}
	27
	28	sub plugindata {
	29	return {
	30	content => [ {backup => 1, none => 1}, { backup => 1 }],
	31	};
	32	}
	33
	34	sub properties {
	35	return {
	36	datastore => {
4133e6e2	37	description => "Proxmox Backup Server datastore name.",
271fe394 DM	38	type => 'string',
	39	},
	40	# openssl s_client -connect <host>:8007 2>&1 \|openssl x509 -fingerprint -sha256
	41	fingerprint => get_standard_option('fingerprint-sha256'),
ce2e2733	42	'encryption-key' => {
1aeb322b	43	description => "Encryption key. Use 'autogen' to generate one automatically without passphrase.",
76bb5feb WB	44	type => 'string',
76bb5feb WB	45	},
4133e6e2 TL	46	port => {
	47	description => "For non default port.",
	48	type => 'integer',
	49	minimum => 1,
	50	maximum => 65535,
	51	default => 8007,
	52	}
271fe394 DM	53	};
	54	}
	55
	56	sub options {
	57	return {
	58	server => { fixed => 1 },
	59	datastore => { fixed => 1 },
4133e6e2	60	port => { optional => 1 },
271fe394 DM	61	nodes => { optional => 1},
	62	disable => { optional => 1},
	63	content => { optional => 1},
	64	username => { optional => 1 },
ce2e2733 TL	65	password => { optional => 1 },
ce2e2733 TL	66	'encryption-key' => { optional => 1 },
271fe394	67	maxfiles => { optional => 1 },
3353698f	68	'prune-backups' => { optional => 1 },
271fe394 DM	69	fingerprint => { optional => 1 },
	70	};
	71	}
	72
	73	# Helpers
	74
	75	sub pbs_password_file_name {
	76	my ($scfg, $storeid) = @_;
	77
462537a2	78	return "/etc/pve/priv/storage/${storeid}.pw";
271fe394 DM	79	}
	80
	81	sub pbs_set_password {
	82	my ($scfg, $storeid, $password) = @_;
	83
	84	my $pwfile = pbs_password_file_name($scfg, $storeid);
9e34813f	85	mkdir "/etc/pve/priv/storage";
271fe394 DM	86
	87	PVE::Tools::file_set_contents($pwfile, "$password\n");
	88	}
	89
	90	sub pbs_delete_password {
	91	my ($scfg, $storeid) = @_;
	92
	93	my $pwfile = pbs_password_file_name($scfg, $storeid);
	94
	95	unlink $pwfile;
	96	}
	97
	98	sub pbs_get_password {
	99	my ($scfg, $storeid) = @_;
	100
	101	my $pwfile = pbs_password_file_name($scfg, $storeid);
	102
	103	return PVE::Tools::file_read_firstline($pwfile);
	104	}
	105
76bb5feb WB	106	sub pbs_encryption_key_file_name {
	107	my ($scfg, $storeid) = @_;
	108
	109	return "/etc/pve/priv/storage/${storeid}.enc";
	110	}
	111
	112	sub pbs_set_encryption_key {
	113	my ($scfg, $storeid, $key) = @_;
	114
	115	my $pwfile = pbs_encryption_key_file_name($scfg, $storeid);
	116	mkdir "/etc/pve/priv/storage";
	117
	118	PVE::Tools::file_set_contents($pwfile, "$key\n");
	119	}
	120
	121	sub pbs_delete_encryption_key {
	122	my ($scfg, $storeid) = @_;
	123
	124	my $pwfile = pbs_encryption_key_file_name($scfg, $storeid);
	125
4ef17e1f TL	126	if (!unlink $pwfile) {
	127	return if $! == ENOENT;
	128	die "failed to delete encryption key! $!\n";
	129	}
18cf6c9f	130	delete $scfg->{'encryption-key'};
76bb5feb WB	131	}
	132
	133	sub pbs_get_encryption_key {
	134	my ($scfg, $storeid) = @_;
	135
	136	my $pwfile = pbs_encryption_key_file_name($scfg, $storeid);
	137
	138	return PVE::Tools::file_get_contents($pwfile);
	139	}
	140
	141	# Returns a file handle if there is an encryption key, or `undef` if there is not. Dies on error.
	142	sub pbs_open_encryption_key {
	143	my ($scfg, $storeid) = @_;
	144
	145	my $encryption_key_file = pbs_encryption_key_file_name($scfg, $storeid);
	146
	147	my $keyfd;
	148	if (!open($keyfd, '<', $encryption_key_file)) {
	149	return undef if $! == ENOENT;
	150	die "failed to open encryption key: $encryption_key_file: $!\n";
	151	}
	152
	153	return $keyfd;
	154	}
	155
8602fd56 FE	156	sub print_volid {
	157	my ($storeid, $btype, $bid, $btime) = @_;
	158
	159	my $time_str = strftime("%FT%TZ", gmtime($btime));
	160	my $volname = "backup/${btype}/${bid}/${time_str}";
	161
	162	return "${storeid}:${volname}";
	163	}
271fe394	164
4133e6e2 TL	165	my sub get_server_with_port {
	166	my ($scfg) = @_;
	167
	168	my $server = $scfg->{server};
	169	$server = "[$server]" if $server =~ /^$IPV6RE$/;
	170
	171	if (my $port = $scfg->{port}) {
	172	$server .= ":$port" if $port != 8007;
	173	}
	174	return $server;
	175	}
	176
02cc5e10 WB	177	my $USE_CRYPT_PARAMS = {
	178	backup => 1,
	179	restore => 1,
	180	'upload-log' => 1,
	181	};
	182
76bb5feb	183	my sub do_raw_client_cmd {
02cc5e10 WB	184	my ($scfg, $storeid, $client_cmd, $param, %opts) = @_;
	185
	186	my $use_crypto = $USE_CRYPT_PARAMS->{$client_cmd};
271fe394	187
1574a590 TL	188	my $client_exe = '/usr/bin/proxmox-backup-client';
	189	die "executable not found '$client_exe'! Proxmox backup client not installed?\n"
	190	if ! -x $client_exe;
	191
4133e6e2	192	my $server = get_server_with_port($scfg);
271fe394 DM	193	my $datastore = $scfg->{datastore};
	194	my $username = $scfg->{username} // 'root@pam';
	195
	196	my $userns_cmd = delete $opts{userns_cmd};
	197
	198	my $cmd = [];
	199
	200	push @$cmd, @$userns_cmd if defined($userns_cmd);
	201
1574a590	202	push @$cmd, $client_exe, $client_cmd;
271fe394	203
76bb5feb WB	204	# This must live in the top scope to not get closed before the `run_command`
76bb5feb WB	205	my $keyfd;
02cc5e10	206	if ($use_crypto) {
76bb5feb WB	207	if (defined($keyfd = pbs_open_encryption_key($scfg, $storeid))) {
	208	my $flags = fcntl($keyfd, F_GETFD, 0)
	209	// die "failed to get file descriptor flags: $!\n";
	210	fcntl($keyfd, F_SETFD, $flags & ~FD_CLOEXEC)
	211	or die "failed to remove FD_CLOEXEC from encryption key file descriptor\n";
	212	push @$cmd, '--crypt-mode=encrypt', '--keyfd='.fileno($keyfd);
	213	} else {
	214	push @$cmd, '--crypt-mode=none';
	215	}
	216	}
	217
271fe394 DM	218	push @$cmd, @$param if defined($param);
	219
	220	push @$cmd, "--repository", "$username\@$server:$datastore";
	221
	222	local $ENV{PBS_PASSWORD} = pbs_get_password($scfg, $storeid);
	223
	224	local $ENV{PBS_FINGERPRINT} = $scfg->{fingerprint};
	225
8b4c2a7e DM	226	# no ascii-art on task logs
	227	local $ENV{PROXMOX_OUTPUT_NO_BORDER} = 1;
	228	local $ENV{PROXMOX_OUTPUT_NO_HEADER} = 1;
	229
271fe394	230	if (my $logfunc = $opts{logfunc}) {
e6d1edcb	231	$logfunc->("run: " . join(' ', @$cmd));
271fe394 DM	232	}
	233
	234	run_command($cmd, %opts);
	235	}
	236
76bb5feb WB	237	# FIXME: External perl code should NOT have access to this.
	238	#
	239	# There should be separate functions to
	240	# - make backups
	241	# - restore backups
	242	# - restore files
	243	# with a sane API
02cc5e10	244	sub run_raw_client_cmd {
76bb5feb	245	my ($scfg, $storeid, $client_cmd, $param, %opts) = @_;
02cc5e10	246	return do_raw_client_cmd($scfg, $storeid, $client_cmd, $param, %opts);
76bb5feb WB	247	}
76bb5feb WB	248
271fe394 DM	249	sub run_client_cmd {
	250	my ($scfg, $storeid, $client_cmd, $param, $no_output) = @_;
	251
	252	my $json_str = '';
fee2ece3	253	my $outfunc = sub { $json_str .= "$_[0]\n" };
271fe394 DM	254
	255	$param = [] if !defined($param);
	256	$param = [ $param ] if !ref($param);
	257
	258	$param = [@$param, '--output-format=json'] if !$no_output;
	259
02cc5e10	260	do_raw_client_cmd($scfg, $storeid, $client_cmd, $param,
76bb5feb	261	outfunc => $outfunc, errmsg => 'proxmox-backup-client failed');
271fe394 DM	262
	263	return undef if $no_output;
	264
	265	my $res = decode_json($json_str);
	266
	267	return $res;
	268	}
	269
	270	# Storage implementation
	271
c855ac15 DM	272	sub extract_vzdump_config {
	273	my ($class, $scfg, $volname, $storeid) = @_;
	274
	275	my ($vtype, $name, $vmid, undef, undef, undef, $format) = $class->parse_volname($volname);
	276
	277	my $config = '';
fee2ece3	278	my $outfunc = sub { $config .= "$_[0]\n" };
c855ac15 DM	279
	280	my $config_name;
	281	if ($format eq 'pbs-vm') {
	282	$config_name = 'qemu-server.conf';
	283	} elsif ($format eq 'pbs-ct') {
	284	$config_name = 'pct.conf';
	285	} else {
	286	die "unable to extract configuration for backup format '$format'\n";
	287	}
	288
02cc5e10	289	do_raw_client_cmd($scfg, $storeid, 'restore', [ $name, $config_name, '-' ],
76bb5feb	290	outfunc => $outfunc, errmsg => 'proxmox-backup-client failed');
c855ac15 DM	291
	292	return $config;
	293	}
	294
8f26b391 FE	295	sub prune_backups {
	296	my ($class, $scfg, $storeid, $keep, $vmid, $type, $dryrun, $logfunc) = @_;
	297
	298	$logfunc //= sub { print "$_[1]\n" };
	299
	300	my $backups = $class->list_volumes($storeid, $scfg, $vmid, ['backup']);
	301
	302	$type = 'vm' if defined($type) && $type eq 'qemu';
	303	$type = 'ct' if defined($type) && $type eq 'lxc';
	304
	305	my $backup_groups = {};
	306	foreach my $backup (@{$backups}) {
	307	(my $backup_type = $backup->{format}) =~ s/^pbs-//;
	308
	309	next if defined($type) && $backup_type ne $type;
	310
	311	my $backup_group = "$backup_type/$backup->{vmid}";
	312	$backup_groups->{$backup_group} = 1;
	313	}
	314
	315	my @param;
	316	foreach my $opt (keys %{$keep}) {
	317	push @param, "--$opt";
	318	push @param, "$keep->{$opt}";
	319	}
	320
	321	push @param, '--dry-run' if $dryrun;
	322
	323	my $prune_list = [];
	324	my $failed;
	325
	326	foreach my $backup_group (keys %{$backup_groups}) {
	327	$logfunc->('info', "running 'proxmox-backup-client prune' for '$backup_group'")
	328	if !$dryrun;
	329	eval {
	330	my $res = run_client_cmd($scfg, $storeid, 'prune', [ $backup_group, @param ]);
	331
	332	foreach my $backup (@{$res}) {
	333	die "result from proxmox-backup-client is not as expected\n"
	334	if !defined($backup->{'backup-time'})
	335	\|\| !defined($backup->{'backup-type'})
	336	\|\| !defined($backup->{'backup-id'})
	337	\|\| !defined($backup->{'keep'});
	338
	339	my $ctime = $backup->{'backup-time'};
	340	my $type = $backup->{'backup-type'};
	341	my $vmid = $backup->{'backup-id'};
	342	my $volid = print_volid($storeid, $type, $vmid, $ctime);
	343
	344	push @{$prune_list}, {
	345	ctime => $ctime,
	346	mark => $backup->{keep} ? 'keep' : 'remove',
	347	type => $type eq 'vm' ? 'qemu' : 'lxc',
	348	vmid => $vmid,
	349	volid => $volid,
	350	};
	351	}
	352	};
	353	if (my $err = $@) {
	354	$logfunc->('err', "prune '$backup_group': $err\n");
	355	$failed = 1;
	356	}
	357	}
	358	die "error pruning backups - check log\n" if $failed;
359
360	return $prune_list;
361	}
362
1aeb322b TL	363	my $autogen_encryption_key = sub {
	364	my ($scfg, $storeid) = @_;
	365	my $encfile = pbs_encryption_key_file_name($scfg, $storeid);
4558cb6e TL	366	my $cmd = ['proxmox-backup-client', 'key', 'create', '--kdf', 'none', $encfile];
	367	run_command($cmd, errmsg => 'failed to create encryption key');
	368	return PVE::Tools::file_get_contents($encfile);
1aeb322b TL	369	};
1aeb322b TL	370
271fe394 DM	371	sub on_add_hook {
	372	my ($class, $storeid, $scfg, %param) = @_;
	373
0b6b98d1 TL	374	my $res = {};
0b6b98d1 TL	375
76bb5feb WB	376	if (defined(my $password = $param{password})) {
76bb5feb WB	377	pbs_set_password($scfg, $storeid, $password);
b494636a DM	378	} else {
	379	pbs_delete_password($scfg, $storeid);
	380	}
76bb5feb	381
ce2e2733	382	if (defined(my $encryption_key = $param{'encryption-key'})) {
1aeb322b	383	if ($encryption_key eq 'autogen') {
0b6b98d1	384	$res->{'encryption-key'} = $autogen_encryption_key->($scfg, $storeid);
1aeb322b TL	385	} else {
1aeb322b TL	386	pbs_set_encryption_key($scfg, $storeid, $encryption_key);
0b6b98d1	387	$res->{'encryption-key'} = $encryption_key;
1aeb322b	388	}
18cf6c9f	389	$scfg->{'encryption-key'} = 1;
76bb5feb WB	390	} else {
	391	pbs_delete_encryption_key($scfg, $storeid);
	392	}
0b6b98d1 TL	393
0b6b98d1 TL	394	return $res;
b494636a DM	395	}
	396
	397	sub on_update_hook {
	398	my ($class, $storeid, $scfg, %param) = @_;
	399
0b6b98d1 TL	400	my $res = {};
0b6b98d1 TL	401
76bb5feb WB	402	if (exists($param{password})) {
	403	if (defined($param{password})) {
	404	pbs_set_password($scfg, $storeid, $param{password});
	405	} else {
	406	pbs_delete_password($scfg, $storeid);
	407	}
	408	}
b494636a	409
ce2e2733 TL	410	if (exists($param{'encryption-key'})) {
ce2e2733 TL	411	if (defined(my $encryption_key = delete($param{'encryption-key'}))) {
1aeb322b	412	if ($encryption_key eq 'autogen') {
0b6b98d1	413	$res->{'encryption-key'} = $autogen_encryption_key->($scfg, $storeid);
1aeb322b TL	414	} else {
1aeb322b TL	415	pbs_set_encryption_key($scfg, $storeid, $encryption_key);
0b6b98d1	416	$res->{'encryption-key'} = $encryption_key;
1aeb322b	417	}
18cf6c9f	418	$scfg->{'encryption-key'} = 1;
76bb5feb WB	419	} else {
	420	pbs_delete_encryption_key($scfg, $storeid);
	421	}
271fe394	422	}
0b6b98d1 TL	423
0b6b98d1 TL	424	return $res;
271fe394 DM	425	}
	426
	427	sub on_delete_hook {
	428	my ($class, $storeid, $scfg) = @_;
	429
	430	pbs_delete_password($scfg, $storeid);
76bb5feb	431	pbs_delete_encryption_key($scfg, $storeid);
271fe394 DM	432	}
	433
	434	sub parse_volname {
	435	my ($class, $volname) = @_;
	436
	437	if ($volname =~ m!^backup/([^\s_]+)/([^\s_]+)/([0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}Z)$!) {
	438	my $btype = $1;
	439	my $bid = $2;
	440	my $btime = $3;
	441	my $format = "pbs-$btype";
	442
	443	my $name = "$btype/$bid/$btime";
	444
	445	if ($bid =~ m/^\d+$/) {
	446	return ('backup', $name, $bid, undef, undef, undef, $format);
	447	} else {
	448	return ('backup', $name, undef, undef, undef, undef, $format);
	449	}
	450	}
	451
	452	die "unable to parse PBS volume name '$volname'\n";
	453	}
	454
	455	sub path {
	456	my ($class, $scfg, $volname, $storeid, $snapname) = @_;
	457
	458	die "volume snapshot is not possible on pbs storage"
	459	if defined($snapname);
	460
	461	my ($vtype, $name, $vmid) = $class->parse_volname($volname);
	462
4133e6e2	463	my $server = get_server_with_port($scfg);
271fe394 DM	464	my $datastore = $scfg->{datastore};
	465	my $username = $scfg->{username} // 'root@pam';
	466
	467	# artifical url - we currently do not use that anywhere
	468	my $path = "pbs://$username\@$server:$datastore/$name";
	469
	470	return ($path, $vmid, $vtype);
	471	}
	472
	473	sub create_base {
	474	my ($class, $storeid, $scfg, $volname) = @_;
	475
	476	die "can't create base images in pbs storage\n";
	477	}
	478
	479	sub clone_image {
	480	my ($class, $scfg, $storeid, $volname, $vmid, $snap) = @_;
	481
	482	die "can't clone images in pbs storage\n";
	483	}
	484
	485	sub alloc_image {
	486	my ($class, $storeid, $scfg, $vmid, $fmt, $name, $size) = @_;
	487
	488	die "can't allocate space in pbs storage\n";
	489	}
	490
	491	sub free_image {
	492	my ($class, $storeid, $scfg, $volname, $isBase) = @_;
	493
	494	my ($vtype, $name, $vmid) = $class->parse_volname($volname);
	495
	496	run_client_cmd($scfg, $storeid, "forget", [ $name ], 1);
	497	}
	498
	499
	500	sub list_images {
	501	my ($class, $storeid, $scfg, $vmid, $vollist, $cache) = @_;
	502
	503	my $res = [];
	504
	505	return $res;
	506	}
	507
	508	sub list_volumes {
	509	my ($class, $storeid, $scfg, $vmid, $content_types) = @_;
	510
	511	my $res = [];
	512
	513	return $res if !grep { $_ eq 'backup' } @$content_types;
	514
	515	my $data = run_client_cmd($scfg, $storeid, "snapshots");
	516
	517	foreach my $item (@$data) {
	518	my $btype = $item->{"backup-type"};
	519	my $bid = $item->{"backup-id"};
545e127e	520	my $epoch = $item->{"backup-time"};
271fe394 DM	521	my $size = $item->{size} // 1;
	522
	523	next if !($btype eq 'vm' \|\| $btype eq 'ct');
	524	next if $bid !~ m/^\d+$/;
ddf7fdaa	525	next if defined($vmid) && $bid ne $vmid;
271fe394	526
8602fd56	527	my $volid = print_volid($storeid, $btype, $bid, $epoch);
271fe394	528
545e127e	529	my $info = {
c05b1a8c TL	530	volid => $volid,
	531	format => "pbs-$btype",
	532	size => $size,
	533	content => 'backup',
	534	vmid => int($bid),
	535	ctime => $epoch,
545e127e	536	};
271fe394	537
9778e5c2 DC	538	$info->{verification} = $item->{verification} if defined($item->{verification});
	539	$info->{comment} = $item->{comment} if defined($item->{comment});
	540
271fe394 DM	541	push @$res, $info;
	542	}
	543
	544	return $res;
	545	}
	546
	547	sub status {
	548	my ($class, $storeid, $scfg, $cache) = @_;
	549
	550	my $total = 0;
	551	my $free = 0;
	552	my $used = 0;
	553	my $active = 0;
	554
	555	eval {
	556	my $res = run_client_cmd($scfg, $storeid, "status");
	557
	558	$active = 1;
	559	$total = $res->{total};
	560	$used = $res->{used};
f155c912 TL	561	$free = $res->{avail};
f155c912 TL	562	};
271fe394 DM	563	if (my $err = $@) {
	564	warn $err;
	565	}
	566
	567	return ($total, $free, $used, $active);
	568	}
	569
	570	sub activate_storage {
	571	my ($class, $storeid, $scfg, $cache) = @_;
bb0a0f96	572
3de42368 TL	573	# a 'status' client command is to expensive here
	574	# TODO: use a dummy ping API call to ensure the PBS API daemon is available for real
	575	my $server = $scfg->{server};
	576	my $port = $scfg->{port} // 8007;
	577	PVE::Network::tcp_ping($server, $port, 2);
bb0a0f96	578
271fe394 DM	579	return 1;
	580	}
	581
	582	sub deactivate_storage {
	583	my ($class, $storeid, $scfg, $cache) = @_;
	584	return 1;
	585	}
	586
	587	sub activate_volume {
	588	my ($class, $storeid, $scfg, $volname, $snapname, $cache) = @_;
	589
	590	die "volume snapshot is not possible on pbs device" if $snapname;
	591
	592	return 1;
	593	}
	594
	595	sub deactivate_volume {
	596	my ($class, $storeid, $scfg, $volname, $snapname, $cache) = @_;
	597
	598	die "volume snapshot is not possible on pbs device" if $snapname;
	599
	600	return 1;
	601	}
	602
	603	sub volume_size_info {
	604	my ($class, $scfg, $storeid, $volname, $timeout) = @_;
	605
	606	my ($vtype, $name, undef, undef, undef, undef, $format) = $class->parse_volname($volname);
	607
	608	my $data = run_client_cmd($scfg, $storeid, "files", [ $name ]);
	609
	610	my $size = 0;
	611	foreach my $info (@$data) {
	612	$size += $info->{size} if $info->{size};
	613	}
	614
	615	my $used = $size;
	616
	617	return wantarray ? ($size, $format, $used, undef) : $size;
	618	}
	619
	620	sub volume_resize {
	621	my ($class, $scfg, $storeid, $volname, $size, $running) = @_;
	622	die "volume resize is not possible on pbs device";
	623	}
	624
	625	sub volume_snapshot {
	626	my ($class, $scfg, $storeid, $volname, $snap) = @_;
	627	die "volume snapshot is not possible on pbs device";
	628	}
	629
	630	sub volume_snapshot_rollback {
	631	my ($class, $scfg, $storeid, $volname, $snap) = @_;
	632	die "volume snapshot rollback is not possible on pbs device";
	633	}
	634
	635	sub volume_snapshot_delete {
	636	my ($class, $scfg, $storeid, $volname, $snap) = @_;
	637	die "volume snapshot delete is not possible on pbs device";
	638	}
	639
	640	sub volume_has_feature {
	641	my ($class, $scfg, $feature, $storeid, $volname, $snapname, $running) = @_;
	642
643	return undef;
644	}
645
646	1;