804 lines
20 KiB
Perl
804 lines
20 KiB
Perl
#
|
|
# Copyright (c) 2013 Klaas Freitag <freitag@owncloud.com>
|
|
#
|
|
# This library is free software; you can redistribute it and/or
|
|
# modify it under the terms of the GNU Lesser General Public
|
|
# License as published by the Free Software Foundation; either
|
|
# version 2.1 of the License, or (at your option) any later version.
|
|
#
|
|
# This library is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
# Lesser General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU Lesser General Public
|
|
# License along with this library; if not, write to the Free Software
|
|
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
#
|
|
################################################################
|
|
# Contributors:
|
|
# Klaas Freitag <freitag@owncloud.com>
|
|
#
|
|
package ownCloud::Test;
|
|
|
|
use strict;
|
|
use Exporter;
|
|
|
|
use HTTP::DAV 0.47;
|
|
use Data::Dumper;
|
|
use File::Glob ':glob';
|
|
use Digest::MD5;
|
|
use Unicode::Normalize;
|
|
use LWP::UserAgent;
|
|
use LWP::Protocol::https;
|
|
use HTTP::Request::Common qw( POST GET DELETE );
|
|
use File::Basename;
|
|
use IO::Handle;
|
|
use POSIX qw/strftime/;
|
|
use Carp;
|
|
|
|
use Encode qw(from_to);
|
|
use utf8;
|
|
if ($^O eq "darwin") {
|
|
eval "require Encode::UTF8Mac";
|
|
}
|
|
|
|
use open ':encoding(utf8)';
|
|
|
|
use vars qw( @ISA @EXPORT @EXPORT_OK $d %config);
|
|
|
|
our $owncloud = "http://localhost/oc/remote.php/webdav/";
|
|
our $owncloud_plain; # the server url without the uniq testing dir
|
|
our $user = "joe";
|
|
our $passwd = 'XXXXX'; # Mind to be secure.
|
|
our $ld_libpath = "/home/joe/owncloud.com/buildcsync/modules";
|
|
our $csync = "/home/joe/owncloud.com/buildcsync/client/ocsync";
|
|
our $ocs_url;
|
|
our $share_user;
|
|
our $share_passwd;
|
|
our $remoteDir;
|
|
our $localDir;
|
|
our $infoCnt = 1;
|
|
our %config;
|
|
|
|
@ISA = qw(Exporter);
|
|
@EXPORT = qw( initTesting createRemoteDir removeRemoteDir createLocalDir cleanup csync
|
|
assertLocalDirs assertLocalAndRemoteDir glob_put put_to_dir
|
|
putToDirLWP localDir remoteDir localCleanup createLocalFile md5OfFile
|
|
remoteCleanup server initLocalDir initRemoteDir moveRemoteFile
|
|
printInfo remoteFileProp remoteFileId createShare removeShare assert
|
|
configValue testDirUrl getToFileLWP getToFileCurl);
|
|
|
|
sub server
|
|
{
|
|
return $owncloud;
|
|
}
|
|
|
|
sub fromFileName($)
|
|
{
|
|
my ($file) = @_;
|
|
if ( $^O eq "darwin" ) {
|
|
my $fromFileName = NFC( Encode::decode('utf-8', $file) );
|
|
return $fromFileName;
|
|
} else {
|
|
return $file;
|
|
}
|
|
}
|
|
|
|
sub setCredentials
|
|
{
|
|
my ($dav, $user, $passwd) = @_;
|
|
|
|
$dav->credentials(-url=> $owncloud, -realm=>"sabre/dav",
|
|
-user=> $user, -pass=> $passwd);
|
|
$dav->credentials(-url=> $owncloud, -realm=>"ownCloud",
|
|
-user=> $user, -pass=> $passwd);
|
|
}
|
|
|
|
|
|
sub initTesting(;$)
|
|
{
|
|
my ($prefix) = @_;
|
|
|
|
my $cfgFile = "./t1.cfg";
|
|
$cfgFile = "/etc/ownCloud/t1.cfg" if( -r "/etc/ownCloud/t1.cfg" );
|
|
|
|
if( -r "$cfgFile" ) {
|
|
%config = do $cfgFile;
|
|
warn "Could not parse t1.cfg: $!\n" unless %config;
|
|
warn "Could not do t1.cfg: $@\n" if $@;
|
|
|
|
$user = $config{user} if( $config{user} );
|
|
$passwd = $config{passwd} if( $config{passwd} );
|
|
$owncloud = $config{url} if( $config{url} );
|
|
$ld_libpath = $config{ld_libpath} if( $config{ld_libpath} );
|
|
$csync = $config{csync} if( $config{csync} );
|
|
$ocs_url = $config{ocs_url} if( $config{ocs_url} );
|
|
$share_user = $config{share_user} if( $config{share_user} );
|
|
$share_passwd = $config{share_passwd} if( $config{share_passwd} );
|
|
|
|
print "Read config from $cfgFile: $config{url}\n";
|
|
} else {
|
|
print STDERR "Could not read a config file $cfgFile\n";
|
|
exit(1);
|
|
}
|
|
|
|
$owncloud .= "/" unless( $owncloud =~ /\/$/ );
|
|
|
|
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
|
|
|
|
print "Connecting to ownCloud at ". $owncloud ."\n";
|
|
|
|
# For SSL set the environment variable needed by the LWP module for SSL
|
|
if( $owncloud =~ /^https/ ) {
|
|
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0
|
|
}
|
|
|
|
my $ua = HTTP::DAV::UserAgent->new(keep_alive => 1 );
|
|
$d = HTTP::DAV->new(-useragent => $ua);
|
|
|
|
setCredentials($d, $user, $passwd);
|
|
# $d->DebugLevel(3);
|
|
$prefix = "t1" unless( defined $prefix );
|
|
|
|
my $dirId = sprintf("%02d", rand(100));
|
|
my $dateTime = strftime('%Y%m%d%H%M%S',localtime);
|
|
my $dir = sprintf( "%s-%s-%s/", $prefix, $dateTime, $dirId );
|
|
|
|
$localDir = $dir;
|
|
$localDir .= "/" unless( $localDir =~ /\/$/ );
|
|
$remoteDir = $dir;
|
|
|
|
initRemoteDir();
|
|
initLocalDir();
|
|
printf( "Test directory name is %s\n", $dir );
|
|
}
|
|
|
|
sub configValue($;$)
|
|
{
|
|
my ($configName, $default) = @_;
|
|
|
|
if( $config{$configName} ) {
|
|
return $config{$configName} ;
|
|
} else {
|
|
return $default;
|
|
}
|
|
}
|
|
|
|
# Returns the full url to the testing dir, ie.
|
|
# http://localhost/owncloud/remote.php/webdav/t1-0543
|
|
sub testDirUrl()
|
|
{
|
|
print "WARN: Remote dir still empty, first call initRemoteDir!\n" unless($remoteDir);
|
|
return $owncloud . $remoteDir;
|
|
}
|
|
|
|
# Call this first to create the unique test dir stored in
|
|
# the global var $remoteDir;
|
|
sub initRemoteDir
|
|
{
|
|
$d->open( $owncloud )
|
|
or die("Couldn't open $owncloud: " .$d->message . "\n");
|
|
|
|
my $url = testDirUrl();
|
|
|
|
my $re = $d->mkcol( $url );
|
|
if( $re == 0 ) {
|
|
print "Failed to create test dir $url\n";
|
|
exit 1;
|
|
}
|
|
|
|
}
|
|
|
|
sub initLocalDir
|
|
{
|
|
mkdir ($localDir, 0777 );
|
|
}
|
|
|
|
sub removeRemoteDir($;$)
|
|
{
|
|
my ($dir, $optionsRef) = @_;
|
|
|
|
my $url = testDirUrl() . $dir;
|
|
if( $optionsRef && $optionsRef->{user} && $optionsRef->{passwd} ) {
|
|
setCredentials($d, $optionsRef->{user}, $optionsRef->{passwd});
|
|
if( $optionsRef->{url} ) {
|
|
$url = $optionsRef->{url} . $dir;
|
|
}
|
|
}
|
|
|
|
$d->open( $owncloud );
|
|
print $d->message . "\n";
|
|
|
|
my $re = $d->delete( $url );
|
|
if( $re == 0 ) {
|
|
print "Failed to remove directory <$url>:" . $d->message() ."\n";
|
|
}
|
|
|
|
return $re;
|
|
}
|
|
|
|
sub createRemoteDir(;$$)
|
|
{
|
|
my ($dir, $optionsRef) = @_;
|
|
|
|
my $url = testDirUrl() . $dir;
|
|
|
|
if( $optionsRef && $optionsRef->{user} && $optionsRef->{passwd} ) {
|
|
setCredentials($d, $optionsRef->{user}, $optionsRef->{passwd});
|
|
if( $optionsRef->{url} ) {
|
|
$url = $optionsRef->{url} . $dir;
|
|
}
|
|
}
|
|
|
|
$d->open( $owncloud );
|
|
print $d->message . "\n";
|
|
|
|
my $re = $d->mkcol( $url );
|
|
if( $re == 0 ) {
|
|
print "Failed to create directory <$url>: " . $d->message() ."\n";
|
|
exit 1;
|
|
}
|
|
$d->open( $url );
|
|
|
|
return $re;
|
|
|
|
}
|
|
|
|
sub createLocalDir($)
|
|
{
|
|
my ($dir) = (@_);
|
|
|
|
$dir = $localDir . $dir;
|
|
print "Creating local dir: $dir\n";
|
|
mkdir( $dir, 0777 );
|
|
}
|
|
|
|
sub cleanup()
|
|
{
|
|
# ==================================================================
|
|
|
|
print "\n################################################\n";
|
|
printf( " all cool - %d tests succeeded in %s.\n", $infoCnt-1, $remoteDir);
|
|
print "#################################################\n";
|
|
|
|
print "\nInterrupt before cleanup in 4 seconds...\n";
|
|
sleep(4);
|
|
|
|
remoteCleanup( '' );
|
|
localCleanup( '' );
|
|
|
|
}
|
|
|
|
sub remoteCleanup($)
|
|
{
|
|
my ($dir) = @_;
|
|
my $url = testDirUrl().$dir;
|
|
$d->open( -url => $url );
|
|
|
|
print "Cleaning Remote!\n";
|
|
|
|
my $re = $d->delete( $url );
|
|
|
|
if( $re == 0 ) {
|
|
print "Failed to cleanup directory <$url>\n";
|
|
}
|
|
return $re;
|
|
}
|
|
|
|
sub localCleanup($)
|
|
{
|
|
my ($dir) = @_;
|
|
# don't play child games here:
|
|
$dir = "$localDir/$dir";
|
|
system( "rm -rf $dir" );
|
|
}
|
|
|
|
# parameter: the expected return code
|
|
sub csync( ;$ )
|
|
{
|
|
my $expected = $_[0] // 0;
|
|
|
|
my $url = testDirUrl();
|
|
if( $url =~ /^https:/ ) {
|
|
$url =~ s#^https://##; # Remove the leading http://
|
|
$url = "ownclouds://$user:$passwd@". $url;
|
|
} elsif( $url =~ /^http:/ ) {
|
|
$url =~ s#^http://##;
|
|
$url = "owncloud://$user:$passwd@". $url;
|
|
}
|
|
|
|
print "CSync URL: $url\n";
|
|
|
|
my $args = "--trust --exclude exclude.cfg"; # Trust crappy SSL certificates
|
|
my $cmd = "LD_LIBRARY_PATH=$ld_libpath $csync $args $localDir $url";
|
|
print "Starting: $cmd\n";
|
|
|
|
my $result = system( $cmd );
|
|
$result == ($expected << 8) or die("Wrong csync return code or crash! $result\n");
|
|
}
|
|
|
|
#
|
|
# Check local directories if they have the same content.
|
|
#
|
|
sub assertLocalDirs( $$ )
|
|
{
|
|
my ($dir1, $dir2) = @_;
|
|
print "Asserting $dir1 <-> $dir2\n";
|
|
|
|
opendir(my $dh, $dir1 ) || die;
|
|
while(readdir $dh) {
|
|
assert( -e "$dir2/$_", " $dir2/$_ do not exist" );
|
|
next if( -d "$dir1/$_"); # don't compare directory sizes.
|
|
my $s1 = -s "$dir1/$_";
|
|
my $s2 = -s "$dir2/$_";
|
|
assert( $s1 == $s2, "$dir1/$_ <-> $dir2/$_ size not equal ($s1 != $s2)" );
|
|
}
|
|
closedir $dh;
|
|
}
|
|
|
|
sub localDir()
|
|
{
|
|
return $localDir;
|
|
}
|
|
|
|
sub remoteDir()
|
|
{
|
|
return $remoteDir;
|
|
}
|
|
#
|
|
# Check if a local and a remote dir have the same content
|
|
#
|
|
|
|
sub assertFile($$)
|
|
{
|
|
my ($localFile, $res) = @_;
|
|
|
|
print "Asserting $localFile and " . $res->get_property("rel_uri") . "\n";
|
|
|
|
my $remoteModTime = $res->get_property( "lastmodifiedepoch" ) ;
|
|
|
|
my $localFile2 = $localFile;
|
|
if ($^O eq "darwin") {
|
|
from_to($localFile2, 'utf-8-mac', 'utf-8');
|
|
}
|
|
my $stat_ok = stat( $localFile2 );
|
|
print " *** STAT failed for $localFile2\n" unless( $stat_ok );
|
|
assert($stat_ok, "Stat failed for file $localFile");
|
|
|
|
my @info = stat( $localFile2 );
|
|
my $localModTime = $info[9];
|
|
assert( $remoteModTime == $localModTime, "Modified-Times differ: remote: $remoteModTime <-> local: $localModTime" );
|
|
print "local versuse Remote modtime: $localModTime <-> $remoteModTime\n";
|
|
# check for the same file size
|
|
my $localSize = $info[7];
|
|
my $remoteSize = $res->get_property( "getcontentlength" );
|
|
if( $remoteSize ) { # directories do not have a contentlength
|
|
print "Local versus Remote size: $localSize <-> $remoteSize\n";
|
|
# assert( $localSize == $remoteSize, "File sizes differ" ); # FIXME enable this again but it causes trouble on Jenkins all the time.
|
|
}
|
|
}
|
|
|
|
sub registerSeen($$)
|
|
{
|
|
my ($seenRef, $file) = @_;
|
|
$seenRef->{$file} = 1;
|
|
}
|
|
|
|
sub traverse( $$;$ )
|
|
{
|
|
my ($remote, $acceptConflicts, $aurl) = @_;
|
|
$remote .= '/' unless $remote =~ /(^|\/)$/;
|
|
|
|
my $url = testDirUrl() . $remote;
|
|
if( $aurl ) {
|
|
$url = $aurl . $remote;
|
|
}
|
|
printf("===============> $url\n");
|
|
my %seen;
|
|
|
|
|
|
setCredentials($d, $user, $passwd);
|
|
$d->open( $owncloud );
|
|
|
|
if( my $r = $d->propfind( -url => $url, -depth => 1 ) ) {
|
|
|
|
if( $r->get_resourcelist ) {
|
|
foreach my $res ( $r->get_resourcelist->get_resources() ) {
|
|
my $filename = $res->get_property("rel_uri");
|
|
|
|
if( $res->is_collection ) {
|
|
# print "Checking " . $res-> get_uri()->as_string ."\n";
|
|
print "Traversing into directory: $filename\n";
|
|
my $dirname = $remote . $filename;
|
|
traverse( $dirname, $acceptConflicts, $aurl );
|
|
my $localDirName = $localDir . $dirname;
|
|
$localDirName =~ s/Shared\///g;
|
|
registerSeen( \%seen, $localDirName); # . $dirname
|
|
} else {
|
|
# Check files here.
|
|
print "Checking file: $remote$filename\n";
|
|
my $localFile = $localDir . $remote . $filename;
|
|
$localFile =~ s/Shared\///g;
|
|
registerSeen( \%seen, $localFile );
|
|
# $localFile =~ s/t1-\d+\//t1\//;
|
|
|
|
assertFile( $localFile, $res );
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
print "Propfind failed: " . $d->message() . "\n";
|
|
}
|
|
|
|
# Check the directory contents
|
|
my $localpath = localDir();
|
|
$localpath .= $remote if( $remote ne "/" );
|
|
$localpath =~ s/Shared\///g;
|
|
print "#### localpath = " . $localpath . "\n";
|
|
opendir(my $dh, $localpath ) || die;
|
|
# print Dumper( %seen );
|
|
while( readdir $dh ) {
|
|
next if( /^\.+$/ );
|
|
my $f = $localpath . fromFileName($_);
|
|
chomp $f;
|
|
assert( -e $f );
|
|
my $isHere = undef;
|
|
if( exists $seen{$f} ) {
|
|
$isHere = 1;
|
|
$seen{$f} = 2;
|
|
}
|
|
if( !$isHere && exists $seen{$f . "/"} ) {
|
|
$isHere = 1;
|
|
$seen{$f."/"} = 3;
|
|
}
|
|
|
|
$isHere = 1 if( $acceptConflicts && !$isHere && $f =~ /_conflict/ );
|
|
$isHere = 1 if( $f =~ /\.csync/ );
|
|
$isHere = 1 if( $f =~ /\._sync_/ );
|
|
assert( $isHere, "Filename local, but not remote: $f" );
|
|
}
|
|
|
|
# Check if there was something remote that we havent locally.
|
|
foreach my $f ( keys %seen ) {
|
|
assert( $seen{$f} > 1, "File on remote, but not locally: $f " . $seen{$f} );
|
|
}
|
|
# print Dumper %seen;
|
|
print "<================ Done $remote\n";
|
|
closedir $dh;
|
|
}
|
|
|
|
sub assertLocalAndRemoteDir( $$;$ )
|
|
{
|
|
my ($remote, $acceptConflicts, $aurl ) = @_;
|
|
traverse( $remote, $acceptConflicts, $aurl );
|
|
}
|
|
|
|
#
|
|
# the third parameter is an optional hash ref that can contain
|
|
# the keys user, passwd and url for alternative connection settings
|
|
#
|
|
sub glob_put( $$;$ )
|
|
{
|
|
my( $globber, $target, $optionsRef ) = @_;
|
|
|
|
my @puts = bsd_glob( $globber );
|
|
foreach my $llfile( @puts ) {
|
|
my $lfile = fromFileName($llfile);
|
|
if( $lfile =~ /.*\/(.+)$/g ) {
|
|
my $rfile = $1;
|
|
my $puturl = "$target"."$rfile";
|
|
if( -d $lfile ) {
|
|
$d->mkcol( $puturl );
|
|
} else {
|
|
$lfile = $llfile;
|
|
$puturl = $target;
|
|
print " *** Putting $lfile to $puturl\n";
|
|
# putToDirLWP( $lfile, $puturl );
|
|
put_to_dir($lfile, $puturl, $optionsRef);
|
|
|
|
# if( ! $d->put( -local=>$lfile, -url=> $puturl ) ) {
|
|
#print " ### FAILED to put: ". $d->message . '\n';
|
|
# s}
|
|
}
|
|
}
|
|
|
|
}
|
|
}
|
|
|
|
sub put_to_dir( $$;$ )
|
|
{
|
|
my ($file, $dir, $optionsRef) = @_;
|
|
|
|
$dir .="/" unless $dir =~ /\/$/;
|
|
my $targetUrl = testDirUrl();
|
|
|
|
if( $optionsRef && $optionsRef->{user} && $optionsRef->{passwd} ) {
|
|
setCredentials($d, $optionsRef->{user}, $optionsRef->{passwd});
|
|
if( $optionsRef->{url} ) {
|
|
$targetUrl = $optionsRef->{url};
|
|
}
|
|
}
|
|
$d->open($targetUrl . $dir);
|
|
|
|
my $filename = $file;
|
|
$filename =~ s/^.*\///;
|
|
$filename =~ s/#/%23/g; # poor man's URI encoder
|
|
my $puturl = $targetUrl . $dir. $filename;
|
|
|
|
print "put_to_dir puts to $puturl\n";
|
|
unless ($d->put( -local => $file, -url => $puturl )) {
|
|
print " ### FAILED to put a single file!\n";
|
|
}
|
|
}
|
|
|
|
# The HTTP DAV module often does a PROPFIND before it really PUTs. That
|
|
# is not neccessary if we know that the directory is really there.
|
|
# Use this function in this case:
|
|
sub putToDirLWP($$)
|
|
{
|
|
my ($file, $dir) = @_;
|
|
|
|
$dir .="/" unless $dir =~ /\/$/;
|
|
|
|
my $filename = $file;
|
|
my $basename = basename $filename;
|
|
|
|
$dir =~ s/^\.\///;
|
|
my $puturl = testDirUrl() . $dir. $basename;
|
|
# print "putToDir LWP puts $filename to $puturl\n";
|
|
die("Could not open $filename: $!") unless( open FILE, "$filename" );
|
|
binmode FILE, ":utf8";;
|
|
my $string = <FILE>;
|
|
close FILE;
|
|
|
|
my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 });
|
|
$ua->agent( "ownCloudTest_$localDir");
|
|
my $req = PUT $puturl, Content_Type => 'application/octet-stream',
|
|
Content => $string;
|
|
$req->authorization_basic($user, $passwd);
|
|
my $response = $ua->request($req);
|
|
|
|
if ($response->is_success()) {
|
|
# print "OK: ", $response->content;
|
|
} else {
|
|
die( "HTTP PUT failed: " . $response->as_string );
|
|
}
|
|
}
|
|
|
|
# does a simple GET of a file in the testdir to a local file.
|
|
|
|
sub getToFileCurl( $$ )
|
|
{
|
|
my ($file, $localFile) = @_;
|
|
my $geturl = testDirUrl() . $file;
|
|
print "GETting $geturl to $localFile\n";
|
|
|
|
my @args = ("curl", "-k", "-u", "$user:$passwd", "$geturl", "-o", "$localFile");
|
|
system( @args );
|
|
}
|
|
|
|
# FIXME: This does not work because I can not get an authenticated GET request
|
|
# that writes its content to a file. Strange.
|
|
sub getToFileLWP( $$ )
|
|
{
|
|
my ($file, $localFile) = @_;
|
|
my $geturl = testDirUrl() . $file;
|
|
print "GETting $geturl to $localFile\n";
|
|
|
|
my $ua = LWP::UserAgent->new( ssl_opts => { verify_hostname => 0 });
|
|
$ua->agent( "ownCloudTest_$localDir");
|
|
$ua->credentials( server(), "foo", $user, $passwd);
|
|
my $req = $ua->get($geturl, ":content_file" => $localFile);
|
|
# my $req = HTTP::Request->new( GET => $geturl, ':content_file' => $localFile);
|
|
# $req->authorization_basic("$user", "$passwd");
|
|
# my $response = $ua->request($req);
|
|
|
|
if ($req->is_success()) {
|
|
print "OK: ", $req->content;
|
|
} else {
|
|
die( "HTTP GET failed: " . $req->as_string );
|
|
}
|
|
}
|
|
|
|
sub createLocalFile( $$ )
|
|
{
|
|
my ($fname, $size) = @_;
|
|
$size = 1024 unless( $size );
|
|
|
|
my $md5 = Digest::MD5->new;
|
|
|
|
open(FILE, ">", $fname) or die "Can't open $fname for writing ($!)";
|
|
|
|
my $minimum = 32;
|
|
my $range = 96;
|
|
|
|
for (my $bytes = 0; $bytes < $size-1; $bytes += 4) {
|
|
my $rand = int(rand($range ** 4));
|
|
my $string = '';
|
|
for (1..4) {
|
|
$string .= chr($rand % $range + $minimum);
|
|
$rand = int($rand / $range);
|
|
}
|
|
print FILE $string;
|
|
$md5->add($string);
|
|
}
|
|
my $s = "\n";
|
|
print FILE $s;
|
|
$md5->add($s);
|
|
close FILE;
|
|
return $md5->hexdigest;
|
|
}
|
|
|
|
sub md5OfFile( $ )
|
|
{
|
|
my ($file) = @_;
|
|
|
|
open FILE, "$file";
|
|
|
|
my $ctx = Digest::MD5->new;
|
|
$ctx->addfile (*FILE);
|
|
my $hash = $ctx->hexdigest;
|
|
close (FILE);
|
|
|
|
return $hash;
|
|
}
|
|
|
|
sub moveRemoteFile($$;$)
|
|
{
|
|
my ($from, $to, $no_testdir) = @_;
|
|
|
|
setCredentials($d, $user, $passwd);
|
|
|
|
my $fromUrl = testDirUrl(). $from;
|
|
my $toUrl = testDirUrl() . $to;
|
|
|
|
if( $no_testdir ) {
|
|
$fromUrl = $from;
|
|
$toUrl = $to;
|
|
}
|
|
|
|
$d->move($fromUrl, $toUrl);
|
|
|
|
}
|
|
|
|
sub printInfo($)
|
|
{
|
|
my ($info) = @_;
|
|
my $tt = 6+length( $info );
|
|
|
|
print "#" x $tt;
|
|
printf( "\n# %2d. %s", $infoCnt, $info );
|
|
print "\n" unless $info =~ /\n$/;
|
|
print "#" x $tt;
|
|
print "\n";
|
|
|
|
$infoCnt++;
|
|
}
|
|
|
|
sub remoteFileProp($$)
|
|
{
|
|
my ($fromDir, $file) = @_;
|
|
my $fromUrl = testDirUrl() . $fromDir;
|
|
my $result;
|
|
|
|
if( my $r = $d->propfind( -url => $fromUrl, -depth => 1 ) ) {
|
|
if ( $r->is_collection ) {
|
|
# print "Collection\n";
|
|
|
|
foreach my $res ( $r->get_resourcelist->get_resources() ) {
|
|
my $filename = $res->get_property("rel_uri");
|
|
# print "OOOOOOOOOOOOOO $filename " . $res->get_property('id') . "\n";
|
|
if( $file eq $filename || $filename eq $file . "/" ) {
|
|
$result = $res;
|
|
}
|
|
}
|
|
} else {
|
|
# print "OOOOOOOOOOOOOOOOOOO " . $r->get_property("rel_uri");
|
|
$result = $r;
|
|
}
|
|
}
|
|
return $result;
|
|
}
|
|
|
|
sub remoteFileId($$)
|
|
{
|
|
my ($fromDir, $file) = @_;
|
|
my $id;
|
|
if( my $res = remoteFileProp($fromDir, $file) ) {
|
|
$id = $res->get_property('id') || "";
|
|
}
|
|
print "## ID of $file: $id\n";
|
|
return $id;
|
|
}
|
|
|
|
# Creates a read write share from the config file user 'share_user' to the
|
|
# config file user 'user'
|
|
# readWrite: permission flag. 31 for all permissions (read/write/create etc)
|
|
# and 1 for read only
|
|
sub createShare($$)
|
|
{
|
|
my ($dir, $readWrite) = @_;
|
|
|
|
my $dd = HTTP::DAV->new();
|
|
|
|
setCredentials($dd, $share_user, $share_passwd);
|
|
$dd->open( $owncloud);
|
|
|
|
# create a remote dir
|
|
my $url = $owncloud . $dir;
|
|
|
|
my $re = $dd->mkcol( $url );
|
|
if( $re == 0 ) {
|
|
print "Failed to create test dir $url\n";
|
|
}
|
|
|
|
my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 } );
|
|
$ua->agent( "ownCloudTest_sharing");
|
|
# http://localhost/ocm/ocs/v1.php/apps/files_sharing/api/v1/shares
|
|
my $puturl = $ocs_url . "apps/files_sharing/api/v1/shares";
|
|
|
|
my $string = "path=$dir&shareType=0&shareWith=$user&publicUpload=false&permissions=$readWrite";
|
|
print ">>>>>>>>>> $puturl $string\n";
|
|
|
|
my $req = POST $puturl, Content => $string;
|
|
$req->authorization_basic($share_user, $share_passwd);
|
|
my $response = $ua->request($req);
|
|
|
|
my $id = 0;
|
|
if ($response->is_success()) {
|
|
# print "OK: ", $response->content;
|
|
print $response->decoded_content;
|
|
if( $response->decoded_content =~ /<id>(\d+)<\/id>/m) {
|
|
$id = $1;
|
|
}
|
|
} else {
|
|
die( "Create sharing failed: " . $response->as_string );
|
|
}
|
|
return $id;
|
|
}
|
|
|
|
sub removeShare($$)
|
|
{
|
|
my ($shareId, $dir) = @_;
|
|
|
|
my $dd = HTTP::DAV->new();
|
|
|
|
setCredentials($dd, $share_user, $share_passwd);
|
|
$dd->open( $owncloud);
|
|
|
|
my $ua = LWP::UserAgent->new(ssl_opts => { verify_hostname => 0 });
|
|
$ua->agent( "ownCloudTest_sharing");
|
|
|
|
my $url = $ocs_url . "ocs/v1.php/apps/files_sharing/api/v1/shares/" . $shareId;
|
|
|
|
my $req = DELETE $url;
|
|
$req->authorization_basic($share_user, $share_passwd);
|
|
my $response = $ua->request($req);
|
|
|
|
if ($response->is_success()) {
|
|
print $response->decoded_content;
|
|
if( $response->decoded_content =~ /<status_code>(\d+)<\/status_code>/m) {
|
|
my $code = $1;
|
|
assert( $code == 100 );
|
|
}
|
|
} else {
|
|
die( "Create sharing failed: " . $response->as_string );
|
|
}
|
|
|
|
# remove the share dir
|
|
my $req = DELETE $owncloud . $dir;
|
|
$req->authorization_basic($share_user, $share_passwd);
|
|
my $response = $ua->request($req);
|
|
}
|
|
|
|
sub assert($;$)
|
|
{
|
|
unless( $_[0] ) {
|
|
print Carp::confess(@_);
|
|
exit(1);
|
|
}
|
|
}
|
|
|
|
#
|