# Functions for accessing the Rackspace cloud files API

# rs_connect(url, user, key)
# Connect to rackspace and get an authentication token. Returns a hash ref for
# a connection handle on success, or an error message on failure.
sub rs_connect
{
my ($url, $user, $key) = @_;
if ($url =~ /^(.*);(\S+)$/) {
	$url = $1;
	$region = lc($2);
	}
my ($host, $port, $page, $ssl) = &parse_http_url($url);
$host || return "Invalid URL : $url";
my $apiver;
if ($url =~ /(v[0-9\.]+)$/) {
	$apiver = $1;
	}
else {
	return "URL does not end with an API version : $url";
	}
my $headers = { 'X-Auth-User' => $user,
		'X-Auth-Key' => $key };
my ($ok, $out, $rs_headers) = &rs_http_call($url, "GET", $headers);
return "Authentication at $url failed : $out" if (!$ok);
if (!$rs_headers->{'X-Auth-Token'}) {
	return "No authentication token received : $out";
	}
my $h = { 'url' => $url,
	  'storage-url' => $rs_headers->{'X-Storage-Url'},
	  'cdn-url' => $rs_headers->{'X-Cdn-Management-Url'},
	  'token' => $rs_headers->{'X-Auth-Token'},
	  'user' => $user,
	  'key' => $key,
	  'api' => $apiver,
	};
if ($config{'rs_snet'}) {
	# Storage URL needs to be customized for the internal network
	$h->{'storage-url'} =~ s/^(http|https):\/\//$1:\/\/snet-/;
	}
if ($region) {
	# Force to a specific region
	$h->{'storage-url'} =~ s/\.([a-z]+)(\d+)\.clouddrive/\.$region$2.clouddrive/;
	}
return $h;
}

# rs_list_containers(&handle)
# Returns a list of containers owned by the user, as an array ref. On error 
# returns the error message string
sub rs_list_containers
{
my ($h) = @_;
my ($ok, $out, $headers) = &rs_api_call($h, "", "GET");
return $out if (!$ok);
return [ split(/\r?\n/, $out) ];
}

# rs_create_container(&handle, container)
# Creates a container with the given name. Returns undef on success, or an
# error message on failure.
sub rs_create_container
{
my ($h, $container) = @_;
my ($ok, $out, $headers) = &rs_api_call($h, "/$container", "PUT");
return $ok ? undef : $out;
}

# rs_stat_container(&handle, container)
# Returns a hash ref with metadata information about some container, or an error
# message on failure. Available keys are like :
# X-Container-Object-Count: 7
# X-Container-Bytes-Used: 413
# X-Container-Meta-InspectedBy: JackWolf
sub rs_stat_container
{
my ($h, $container) = @_;
my ($ok, $out, $headers) = &rs_api_call($h, "/$container", "HEAD");
return $out if (!$ok);
return $headers;
}

# rs_delete_container(&handle, container, [recursive])
# Deletes some container from rackspace. Returns an error message on failure, or
# undef on success
sub rs_delete_container
{
my ($h, $container, $recursive) = @_;
if ($recursive) {
	my $files = &rs_list_objects($h, $container);
	return $files if (!ref($files));
	foreach my $f (@$files) {
		my $err = &rs_delete_object($h, $container, $f);
		return "$f : $err" if ($err);
		}
	}
my ($ok, $out, $headers) = &rs_api_call($h, "/$container", "DELETE");
return $ok ? undef : $out;
}

# rs_list_objects(&handle, container)
# Returns a list of object filenames in some container, as an array ref. On 
# error returns the error message string
sub rs_list_objects
{
my ($h, $container) = @_;
my $chunk = 10000;
my @all;
my $marker;
while(1) {
	my ($ok, $out, $headers) = &rs_api_call($h,
		"/$container?limit=$chunk".
		($marker eq '' ? '' : "&marker=$marker"), "GET");
	return $out if (!$ok);
	my @part = split(/\r?\n/, $out);
	last if (!@part);		# No more
	push(@all, @part);
	last if (@part < $chunk);	# Got less than the chunk size
	$marker = $part[$#part];
	}
return \@all;
}

# rs_upload_object(&handle, container, file, source-file, [multipart],
# 		   [force-chunk-size])
# Uploads the contents of some local file to rackspace. Returns undef on success
# or an error message string if something goes wrong
sub rs_upload_object
{
my ($h, $container, $file, $src, $multipart, $chunk) = @_;
my $def_rs_chunk_size = $config{'rs_chunk'}*1024*1024 || 200*1024*1024; # 200 MB
$chunk ||= $def_rs_chunk_size;
my @st = stat($src);
@st || return "File $src does not exist";
if ($st[7] >= 2*1024*1024*1024 || $multipart) {
	# Large files have to be uploaded in parts
	my $pos = 0;
	my $pinheaders = { 'X-Object-Meta-PIN' => int(rand()*10000) };
	my $n = "00000000";
	while($pos < $st[7]) {
		# Upload a chunk
		my $want = $st[7] - $pos;
		if ($want > $chunk) {
			$want = $chunk;
			}
		my ($ok, $out);
		for(my $try=0; $try<3; $try++) {
			($ok, $out) = &rs_api_call($h, "/$container/$file.$n",
					"PUT", $pinheaders, undef, $src,
					$pos, $want);
			last if ($ok);
			}
		if (!$ok) {
			close(CHUNK);
			return "Upload failed at $pos : $out";
			}
		$pos += $want;
		$n++;
		}
	close(CHUNK);

	# Finally upload the manifest
	$pinheaders->{'X-Object-Manifest'} = "$container/$file";
	my ($ok, $out) = &rs_api_call($h, "/$container/$file", "PUT",
                                      $pinheaders, undef, "");
	return $ok ? undef : "Manifest upload filed : $out";
	}
else {
	# Can upload in a single API call
	my ($ok, $out) = &rs_api_call($h, "/$container/$file", "PUT",
				      undef, undef, $src);
	return $ok ? undef : $out;
	}
}

# rs_download_object(&handle, container, file, dest-file)
# Downloads the contents of rackspace file to local. Returns undef on success
# or an error message string if something goes wrong
sub rs_download_object
{
my ($h, $container, $file, $dst) = @_;
my ($ok, $out) = &rs_api_call($h, "/$container/$file", "GET",
			      undef, $dst);
return $ok ? undef : $out;
}

# rs_stat_object(&handle, container, file)
# Returns a hash ref with metadata information about some object, or an error
# message on failure. Available keys are like :
# Last-Modified: Fri, 12 Jun 2007 13:40:18 GMT
# ETag: 8a964ee2a5e88be344f36c22562a6486
# Content-Length: 512000
# Content-Type: text/plain; charset=UTF-8
# X-Object-Meta-Meat: Bacon
sub rs_stat_object
{
my ($h, $container, $file) = @_;
my ($ok, $out, $headers) = &rs_api_call($h, "/$container/$file", "HEAD");
return $out if (!$ok);
return $headers;
}

# rs_delete_object(&handle, container, file)
# Deletes some file from a container. Returns an error message on failure, or
# undef on success
sub rs_delete_object
{
my ($h, $container, $file) = @_;
my $st = &rs_stat_object($h, $container, $file);
if (ref($st) && $st->{'X-Object-Manifest'}) {
	# Looks multi-part .. delete the parts first
	my ($mcontainer, $mprefix) = split(/\//, $st->{'X-Object-Manifest'});
	if ($mprefix !~ /\S/ || $mcontainer !~ /\S/) {
		return "X-Object-Manifest header on file $file does not ".
		       "contain a prefix : $st->{'X-Object-Manifest'}";
		}
	my $files = &rs_list_objects($h, $mcontainer);
	return "Failed to find parts : $files" if (!ref($files));
	foreach my $f (@$files) {
		if ($f =~ /^\Q$mprefix\E/ && $f ne $file) {
			my ($ok, $out) = &rs_api_call($h, "/$mcontainer/$f",
						      "DELETE");
			return "Failed to delete part $f : $out" if (!$ok);
			}
		}
	}
my ($ok, $out) = &rs_api_call($h, "/$container/$file", "DELETE");
return $ok ? undef : $out;
}

# rs_api_call(&handle, path, method, &headers, [save-to-file],
# 	      [read-from-file|data], [file-offset], [file-length])
# Calls the rackspace API, and returns an OK flag, response body or error
# message, and HTTP headers.
sub rs_api_call
{
my ($h, $path, $method, $headers, $dstfile, $srcfile, $offset, $length) = @_;
my ($host, $port, $page, $ssl) = &parse_http_url($h->{'storage-url'});
my $sendheaders = $headers ? { %$headers } : { };
$sendheaders->{'X-Auth-Token'} = $h->{'token'};
return &rs_http_call($h->{'storage-url'}.$path, $method, $sendheaders,
		     $dstfile, $srcfile, $offset, $length);
}

# rs_http_call(url, method, &headers, [save-to-file], [read-from-file|data],
# 	       [file-offset], [file-length], [retry-attempts])
# Makes an HTTP call and returns an OK flag, response body or error
# message, and HTTP headers. Re-tries in the face of a transient failure.
sub rs_http_call
{
my ($url, $method, $headers, $dstfile, $srcfile, $offset, $length, $tries) = @_;
$tries ||= $rs_upload_tries;
local @rv;

for(my $i=0; $i<$tries; $i++) {
	@rv = &rs_http_single_call($url, $method, $headers, $dstfile, $srcfile,
				   $offset, $length);
	return @rv if ($rv[0]);		# Success
	return @rv if ($rv[1] !~ /^(Invalid|Empty)\s+HTTP\s+response/i);
	sleep(10);
	}
return @rv;	# Failure after reveral re-tries
}

# rs_http_single_call(url, method, &headers, [save-to-file], [read-from-file|data],
# 	              [file-offset], [file-length])
# Makes an HTTP call and returns an OK flag, response body or error
# message, and HTTP headers.
sub rs_http_single_call
{
my ($url, $method, $headers, $dstfile, $srcfile, $offset, $length) = @_;
my ($host, $port, $page, $ssl) = &parse_http_url($url);

# Build headers
my @headers;
push(@headers, [ "Host", $host ]);
push(@headers, [ "User-agent", "Webmin" ]);
push(@headers, [ "Accept-language", "en" ]);
foreach my $hname (keys %$headers) {
	push(@headers, [ $hname, $headers->{$hname} ]);
	}
if ($srcfile =~ /^\// && -r $srcfile) {
	if ($length) {
		push(@headers, [ "Content-Length", $length ]);
		}
	else {
		my @st = stat($srcfile);
		push(@headers, [ "Content-Length", $st[7] ]);
		}
	}
elsif (defined($srcfile)) {
	push(@headers, [ "Content-Length", length($srcfile) ]);
	}

# Make the HTTP connection
$main::download_timed_out = undef;
local $SIG{ALRM} = \&download_timeout;
alarm(60);
my $h = &make_http_connection($host, $port, $ssl, $method, $page, \@headers);
alarm(0);
$h = $main::download_timed_out if ($main::download_timed_out);
if (!ref($h)) {
	return (0, $h);
	}

if ($srcfile =~ /^\// && -r $srcfile) {
	# Send body contents from file
	my $buf;
	open(SRCFILE, "<".$srcfile);
	if ($offset) {
		# Seek to some position
		seek(SRCFILE, $offset, 0);
		}
	if ($length) {
		# Only copy length bytes
		my $want = $length;
		while($want) {
			my $readlen = $want;
			if ($readlen > 1024*1024) {
				$readlen = 1024*1024;
				}
			my $got = read(SRCFILE, $buf, $readlen);
			&write_http_connection($h, $buf);
			$want -= $got;
			}
		}
	else {
		# Copy till the end of the file
		while(read(SRCFILE, $buf, &get_buffer_size()) > 0) {
			&write_http_connection($h, $buf);
			}
		}
	close(SRCFILE);
	}
elsif (defined($srcfile)) {
	# Send body contents from string
	&write_http_connection($h, $srcfile);
	}

my ($out, $error);

# Read headers
alarm(60);
my $line;
($line = &read_http_connection($h)) =~ tr/\r\n//d;
if ($line !~ /^HTTP\/1\..\s+(20[0-9])(\s+|$)/) {
	alarm(0);
	&close_http_connection($h);
	return (0, $line ? "Invalid HTTP response : $line"
			 : "Empty HTTP response");
	}
my $rcode = $1;
my %header;
while(1) {
	$line = &read_http_connection($h);
	$line =~ tr/\r\n//d;
	$line =~ /^(\S+):\s+(.*)$/ || last;
	$header{$1} = $2;
	}
alarm(0);
if ($main::download_timed_out) {
	&close_http_connection($h);
	return (0, $main::download_timed_out);
	}

# Read data
my $out;
if (!$dstfile) {
	# Append to a variable
	while(defined($buf = &read_http_connection($h, 1024))) {
		$out .= $buf;
		}
	}
else {
	# Write to a file
	my $got = 0;
	if (!&open_tempfile(PFILE, ">$dstfile", 1)) {
		&close_http_connection($h);
		return (0, "Failed to write to $dstfile : $!");
		}
	binmode(PFILE);		# For windows
	while(defined($buf = &read_http_connection($h, 1024))) {
		&print_tempfile(PFILE, $buf);
		$got += length($buf);
		}
	&close_tempfile(PFILE);
	if ($header{'content-length'} &&
	    $got != $header{'content-length'}) {
		&close_http_connection($h);
		return (0, "Download incomplete");
		}
	}
&close_http_connection($h);

return (1, $out, \%header);
}

1;