lib/MogileFS/Test.pm

   1 package MogileFS::Test;
   2
   3 use strict;
   4 use warnings;
   5 use DBI;
   6
   7 use FindBin qw($Bin);
   8 use IO::Socket::INET;
   9 use MogileFS::Server;
  10 use LWP::UserAgent;
  11 use base 'Exporter';
  12
  13 our @EXPORT = qw(&find_mogclient_or_skip &temp_store &create_mogstored &create_temp_tracker &try_for &want);
  14
  15 sub find_mogclient_or_skip {
  16
  17     # needed for running "make test" from project root directory, with
  18     # full svn 'mogilefs' repo checked out, without installing
  19     # MogileFS::Client to normal system locations...
  20     #
  21     # then, second path is when running "make disttest", which is another
  22     # directory below.
  23     foreach my $dir ("$Bin/../../api/perl/MogileFS-Client/lib",
  24                      "$Bin/../../../api/perl/MogileFS-Client/lib",
  25                      ) {
  26         next unless -d $dir;
  27         unshift @INC, $dir;
  28         $ENV{PERL5LIB} = $dir . ($ENV{PERL5LIB} ? ":$ENV{PERL5LIB}" : "");
  29     }
  30
  31     unless (eval "use MogileFS::Client; 1") {
  32         warn "Can't find MogileFS::Client: $@\n";
  33         Test::More::plan('skip_all' => "Can't find MogileFS::Client library, necessary for testing.");
  34     }
  35
  36     unless (eval { TrackerHandle::_mogadm_exe() }) {
  37         warn "Can't find mogadm utility $@\n";
  38         Test::More::plan('skip_all' => "Can't find mogadm executable, necessary for testing.");
  39     }
  40
  41     return 1;
  42 }
  43
  44 sub temp_store {
  45     my $type = $ENV{MOGTEST_DBTYPE};
  46     my $host = $ENV{MOGTEST_DBHOST} || '';
  47     my $port = $ENV{MOGTEST_DBPORT} || '';
  48     my $user = $ENV{MOGTEST_DBUSER} || '';
  49     my $pass = $ENV{MOGTEST_DBPASS} || '';
  50     my $name = $ENV{MOGTEST_DBNAME} || '';
  51     my $rootuser = $ENV{MOGTEST_DBROOTUSER} || '';
  52     my $rootpass = $ENV{MOGTEST_DBROOTPASS} || '';
  53
  54     # default to mysql, but make sure DBD::MySQL is installed
  55     unless ($type) {
  56         $type = "MySQL";
  57         eval "use DBD::mysql; 1" or
  58             die "DBD::mysql isn't installed.  Please install it or define MOGTEST_DBTYPE env. variable";
  59     }
  60
  61     die "Bogus type" unless $type =~ /^\w+$/;
  62     my $store = "MogileFS::Store::$type";
  63     eval "use $store; 1;";
  64     if ($@) {
  65         die "Failed to load $store: $@\n";
  66     }
  67     my %opts = ( dbhost => $host, dbport => $port,
  68                  dbuser => $user, dbpass => $pass,
  69                  dbname => $name);
  70     $opts{dbrootuser} = $rootuser unless $rootuser eq '';
  71     $opts{dbrootpass} = $rootpass unless $rootpass eq '';
  72     my $sto = $store->new_temp(%opts);
  73     Mgd::set_store($sto);
  74     return $sto;
  75 }
  76
  77
  78 sub create_temp_tracker {
  79     my $sto = shift;
  80     my $opts = shift || [];
  81
  82     my $pid = fork();
  83     my $whoami = `whoami`;
  84     chomp $whoami;
  85
  86     my $connect = sub {
  87         return IO::Socket::INET->new(PeerAddr => "127.0.0.1:7001",
  88                                      Timeout  => 2);
  89     };
  90
  91     my $conn = $connect->();
  92     die "Failed:  tracker already running on port 7001?\n" if $conn;
  93
  94     unless ($pid) {
  95         exec("$Bin/../mogilefsd",
  96              ($whoami eq "root" ? "--user=root" : ()),
  97              "--skipconfig",
  98              "--workers=2",
  99              "--dsn=" . $sto->dsn,
 100              "--dbuser=" . $sto->user,
 101              "--dbpass=" . $sto->pass,
 102              @$opts,
 103              );
 104     }
 105
 106     for (1..3) {
 107         if ($connect->()) {
 108             return TrackerHandle->new(pid => $pid);
 109         }
 110         sleep 1;
 111     }
 112     return undef;
 113 }
 114
 115 sub create_mogstored {
 116     my ($ip, $root, $daemonize) = @_;
 117
 118     my $connect = sub {
 119         return IO::Socket::INET->new(PeerAddr => "$ip:7500",
 120                                      Timeout  => 2);
 121     };
 122
 123     my $conn = $connect->();
 124     die "Failed:  tracker already running on port 7500?\n" if $conn;
 125     $ENV{PERL5LIB} .= ":$Bin/../lib";
 126     my @args = ("$Bin/../mogstored",
 127                 "--skipconfig",
 128                 "--httplisten=$ip:7500",
 129                 "--mgmtlisten=$ip:7501",
 130                 "--maxconns=1000",  # because we're not root, put it below 1024
 131                 "--docroot=$root");
 132
 133     my $pid;
 134     if ($daemonize) {
 135         # don't set pid.  since our fork fid would just
 136         # go away, once perlbal daemonized itself.
 137         push @args, "--daemonize";
 138         system(@args) and die "Failed to start daemonized mogstored.";
 139     } else {
 140         $pid = fork();
 141         die "failed to fork: $!" unless defined $pid;
 142         unless ($pid) {
 143             exec(@args);
 144         }
 145     }
 146
 147     for (1..12) {
 148         if ($connect->()) {
 149             return MogstoredHandle->new(pid => $pid, ip => $ip, root => $root);
 150         }
 151         select undef, undef, undef, 0.25;
 152     }
 153     return undef;
 154 }
 155
 156 sub try_for {
 157     my ($tries, $code) = @_;
 158     for (1..$tries) {
 159         return 1 if $code->();
 160         sleep 1;
 161     }
 162     return 0;
 163 }
 164
 165 sub want {
 166     my ($admin, $count, $jobclass) = @_;
 167     my $req = "!want $count $jobclass\r\n";
 168
 169     syswrite($admin, $req) or die "syswrite: $!\n";
 170
 171     my $r = <$admin>;
 172     if ($r =~ /Now desiring $count children doing '$jobclass'/ && <$admin> eq ".\r\n") {
 173             my $rcount;
 174             try_for(30, sub {
 175             $rcount = -1;
 176             syswrite($admin, "!jobs\r\n");
 177             MogileFS::Util::wait_for_readability(fileno($admin), 10);
 178             while (1) {
 179                 my $line = <$admin>;
 180                 if ($line =~ /\A$jobclass count (\d+)/) {
 181                     $rcount = $1;
 182                 }
 183                 last if $line eq ".\r\n";
 184             }
 185             $rcount == $count;
 186         });
 187         return 1 if $rcount == $count;
 188         die "got $jobclass count $rcount (expected=$count)\n";
 189     }
 190     die "got bad response for $req: $r\n";
 191 }
 192
 193 ############################################################################
 194 package ProcessHandle;
 195 sub new {
 196     my ($class, %args) = @_;
 197     bless \%args, $class;
 198 }
 199
 200 sub pid { return $_[0]{pid} }
 201
 202 sub DESTROY {
 203     my $self = shift;
 204     return unless $self->{pid};
 205     kill 15, $self->{pid};
 206 }
 207
 208
 209 ############################################################################
 210
 211 package TrackerHandle;
 212 use base 'ProcessHandle';
 213
 214 sub ipport {
 215     my $self = shift;
 216     return "127.0.0.1:7001";
 217 }
 218
 219 my $_mogadm_exe_cache;
 220 sub _mogadm_exe {
 221     return $_mogadm_exe_cache if $_mogadm_exe_cache;
 222     for my $dir ("$FindBin::Bin/../../utils",
 223                      "$FindBin::Bin/../../../utils",
 224                      split(/:/, $ENV{PATH}),
 225                      "/usr/bin",
 226                      "/usr/sbin",
 227                      "/usr/local/bin",
 228                      "/usr/local/sbin",
 229                      ) {
 230         my $exe = $dir . '/mogadm';
 231         return $_mogadm_exe_cache = $exe if -x $exe;
 232     }
 233     die "mogadm executable not found.\n";
 234 }
 235
 236 sub mogadm {
 237     my $self = shift;
 238     my $rv = system(_mogadm_exe(), "--trackers=" . $self->ipport, @_);
 239     return !$rv;
 240 }
 241
 242 ############################################################################
 243 package MogstoredHandle;
 244 use base 'ProcessHandle';
 245
 246 # this space intentionally left blank.  all in super class for now.
 247
 248 ############################################################################
 249 package MogPath;
 250 sub new {
 251     my ($class, $url) = @_;
 252     return bless {
 253         url => $url,
 254     }, $class;
 255 }
 256
 257 sub host {
 258     my $self = shift;
 259     my ($host1) = $self->{url} =~ m!^http://(.+:\d+)!;
 260     return $host1
 261 }
 262
 263 sub device {
 264     my $self = shift;
 265     my ($dev) = $self->{url} =~ m!dev(\d+)!;
 266     return $dev
 267 }
 268
 269 sub path {
 270     my $self = shift;
 271     my $path = $self->{url};
 272     $path =~ s!^http://(.+:\d+)!!;
 273     return $path;
 274 }
 275
 276 1;