├── .gitignore ├── .shipit ├── CHANGES ├── MANIFEST ├── MANIFEST.SKIP ├── META.yml ├── Makefile.PL ├── MogileFS-Client.spec ├── TODO ├── debian ├── changelog ├── compat ├── control ├── copyright ├── libmogilefs-perl.install ├── rules └── watch ├── lib └── MogileFS │ ├── Admin.pm │ ├── Backend.pm │ ├── Client.pm │ ├── ClientHTTPFile.pm │ └── NewHTTPFile.pm └── t ├── 00use.t ├── 10-basics.t ├── 20-edit.t └── 30-disconnect.t /.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | blib 3 | pm_to_blib 4 | -------------------------------------------------------------------------------- /.shipit: -------------------------------------------------------------------------------- 1 | # auto-generated shipit config file. 2 | steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN 3 | 4 | git.tagpattern = %v 5 | 6 | -------------------------------------------------------------------------------- /CHANGES: -------------------------------------------------------------------------------- 1 | 1.16 - 2012-03-30 2 | 3 | * Allow fetching hashtype in get_domains (eric wong) 4 | 5 | 1.15 - 2012-01-27 6 | 7 | * Fix error in NewHTTPFile (Daniel.Bergmann) 8 | 9 | * Fixed build if the directory is named perl-MogileFS-Client. (Andrei Pascha ) 10 | 11 | 1.14 - 2011-01-08 12 | 13 | * support the file_debug command (dormando ) 14 | 15 | * file_info command for fetching file metadata (dormando ) 16 | 17 | * update some variables (dormando ) 18 | 19 | * Update specfile version (Jonathan Steinert ) 20 | 21 | * Ignore INSTALL_BASE during rpm building. (Jonathan Steinert ) 22 | 23 | 1.13 - 2010-09-28 24 | 25 | * rebalance admin commands 26 | 27 | 1.12 - 2010-08-13 28 | 29 | * update_class command (requires 2.37 of mogilefs-server) (t0m) 30 | 31 | * Improve error message on hostname lookup failure (t0m) 32 | 33 | 1.11 - 2010-04-02 34 | 35 | * Support replpolicy as an argument to class add/modify (dormando) 36 | 37 | * Don't reuse dead socket on more error conditions (t0m) 38 | 39 | * Add chunk_size option for store_file to speed up large uploads 40 | (dormando) 41 | 42 | * Add extra info to write failure errors (t0m) 43 | 44 | 1.10 - 2009-12-05 45 | 46 | * Support sending a timeout for admin commands (robbat2) 47 | 48 | 1.09 - 2009-10-16 49 | 50 | * Change really misleading timeout error message. 51 | 52 | * Add optional startpos argument to fsck_reset. 53 | 54 | * Add experimental 'edit_file' command, making use of ClientHTTPFile. 55 | 56 | * Add 'read_file' command, which returns a seekable filehandle 57 | to a mogile key, making use of ClientHTTPFile. 58 | 59 | * Add new ClientHTTPFile backend as an alternate to NewHTTPFile. 60 | This is used if the 'largefile' option is passed to new_file. 61 | 62 | 1.08 - 2007-08-06 63 | 64 | * Include update_device command for consistency. 65 | 66 | * Include 'clear_cache' command. 67 | 68 | * updated docs 69 | 70 | 1.07 - 2006-05-03 71 | 72 | * 'settings list' and 'settings set ' commands. 73 | use for enabling rebalancing, slaves, memcaches, etc. 74 | 75 | 1.06 - 2006-04-20 76 | 77 | * add fsck mgmt/status/querying commands to MogileFS::Admin 78 | 79 | 1.05 - 2007-04-16 80 | 81 | * POD docs! 82 | 83 | * Add create_open_args and create_close_args which can be passed to 84 | new_file (plus store_file and store_content). This can be used to 85 | pass extra information to plugins running in the tracker. 86 | 87 | 1.04 - Mar 26, 2007 88 | 89 | * add observed_state and I/O utiliz% columns to mogadm check. 90 | 91 | * removed support for non-http:// storage node URLs. that is, 92 | "NFS mode" is now gone. yay. it always sucked. 93 | 94 | 1.03 - Sep 25, 2006 95 | 96 | * rename from MogileFS to MogileFS::Client, add POD, prep for 97 | future work. 98 | 99 | * more verbose error messages 100 | 101 | * AUTOLOAD-proxy unknown methods to server for server-based 102 | plugins (Mark Smith) 103 | 104 | * Andreas J. Koenig : 105 | The following bugfix guards against externally influenced $/. In 106 | our case, somebody (not @danga :) had set $/ to undef and so the 107 | application was hanging forever. 108 | 109 | 1.01 - Jan 10, 2005 110 | 111 | * fix CPU spinning bug in _getline where we didn't handle 112 | sysread() returning 0. (Brad) 113 | 114 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | Makefile.PL 2 | MANIFEST 3 | MANIFEST.SKIP 4 | lib/MogileFS/Client.pm 5 | lib/MogileFS/Admin.pm 6 | lib/MogileFS/Backend.pm 7 | lib/MogileFS/ClientHTTPFile.pm 8 | lib/MogileFS/NewHTTPFile.pm 9 | META.yml Module meta-data (added by MakeMaker) 10 | t/00use.t 11 | t/10-basics.t 12 | t/20-edit.t 13 | CHANGES 14 | TODO 15 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | MogileFS-Client.spec 2 | ^# 3 | \bCVS\b 4 | ^MANIFEST\. 5 | ^Makefile$ 6 | ~$ 7 | \.html$ 8 | \.old$ 9 | ^blib/ 10 | _blib$ 11 | ^MakeMaker-\d 12 | ^\.exists 13 | \bdebian\b 14 | \btest\b 15 | 16 | # Avoid version control files. 17 | \bRCS\b 18 | \bCVS\b 19 | ,v$ 20 | \B\.svn\b 21 | \B\.git\b 22 | 23 | # Avoid Makemaker generated and utility files. 24 | \bMANIFEST\.bak 25 | \bMakefile$ 26 | \bblib/ 27 | \bMakeMaker-\d 28 | \bpm_to_blib$ 29 | 30 | # Avoid Module::Build generated and utility files. 31 | \bBuild$ 32 | \b_build/ 33 | 34 | # Avoid temp and backup files. 35 | ~$ 36 | \.old$ 37 | \#$ 38 | \b\.# 39 | -------------------------------------------------------------------------------- /META.yml: -------------------------------------------------------------------------------- 1 | # http://module-build.sourceforge.net/META-spec.html 2 | #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# 3 | name: MogileFS-Client 4 | version: 1.08 5 | version_from: lib/MogileFS/Client.pm 6 | installdirs: site 7 | requires: 8 | fields: 0 9 | IO::WrapTie: 2.102 10 | LWP::Simple: 0 11 | Test::More: 0 12 | 13 | distribution_type: module 14 | generated_by: ExtUtils::MakeMaker version 6.17 15 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 3 | # Perl Makefile for Danga-Socket 4 | # $Id$ 5 | # 6 | # Invoke with 'perl Makefile.PL' 7 | # 8 | # See ExtUtils::MakeMaker (3) for more information on how to influence 9 | # the contents of the Makefile that is written 10 | # 11 | 12 | use ExtUtils::MakeMaker; 13 | 14 | WriteMakefile( 15 | NAME => 'MogileFS::Client', 16 | VERSION_FROM => 'lib/MogileFS/Client.pm', 17 | AUTHOR => 'Brad Fitzpatrick ', 18 | ABSTRACT => 'MogileFS client library', 19 | PREREQ_PM => { 20 | 'Time::HiRes' => 0, 21 | 'IO::WrapTie' => '2.102', 22 | 'LWP::Simple' => 0, 23 | fields => 0, 24 | 'Test::More' => 0, 25 | 'List::Util' => 0, 26 | }, 27 | ); 28 | 29 | -------------------------------------------------------------------------------- /MogileFS-Client.spec: -------------------------------------------------------------------------------- 1 | name: perl-MogileFS-Client 2 | summary: perl-MogileFS-Client - Perl client library for accessing MogileFS 3 | version: 1.14 4 | release: 1%{?dist} 5 | vendor: Alan Kasindorf 6 | packager: Jonathan Steinert 7 | license: Artistic 8 | group: Applications/CPAN 9 | buildroot: %{_tmppath}/%{name}-%{version}-%(id -u -n) 10 | buildarch: noarch 11 | source: MogileFS-Client-%{version}.tar.gz 12 | requires: perl(IO::WrapTie) >= 2.102 13 | buildrequires: perl(IO::WrapTie) >= 2.102 14 | 15 | %description 16 | Perl client library for accessing MogileFS 17 | 18 | %prep 19 | rm -rf "%{buildroot}" 20 | %setup -n MogileFS-Client-%{version} 21 | 22 | %build 23 | %{__perl} Makefile.PL PREFIX=%{buildroot}%{_prefix} INSTALL_BASE= 24 | make all 25 | make test 26 | 27 | %install 28 | make pure_install 29 | 30 | [ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress 31 | 32 | 33 | # remove special files 34 | find %{buildroot} \( \ 35 | -name "perllocal.pod" \ 36 | -o -name ".packlist" \ 37 | -o -name "*.bs" \ 38 | \) -exec rm -f {} \; 39 | 40 | # no empty directories 41 | find %{buildroot}%{_prefix} \ 42 | -type d -depth -empty \ 43 | -exec rmdir {} \; 44 | 45 | %clean 46 | [ "%{buildroot}" != "/" ] && rm -rf %{buildroot} 47 | 48 | %files 49 | %defattr(-,root,root) 50 | %{_prefix}/lib/* 51 | %{_prefix}/share/man 52 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | -- add POD 2 | 3 | -- write in parallel to two hosts. 4 | * extend server protocol to tell it two hosts already have the right copy, 5 | not just one 6 | -------------------------------------------------------------------------------- /debian/changelog: -------------------------------------------------------------------------------- 1 | libmogilefs-perl (1.14-2) stable; urgency=low 2 | 3 | * fixed packaging with perl-MogileFS-Client as base directory 4 | 5 | -- Andre Pascha Mon, 10 Jan 2011 16:20:21 +0100 6 | 7 | libmogilefs-perl (1.14-1) lenny; urgency=low 8 | 9 | * new upstream release 10 | 11 | -- root Mon, 10 Jan 2011 13:38:55 +0100 12 | 13 | libmogilefs-perl (1.13-1kwick1) lenny; urgency=low 14 | 15 | * moved to gibthub version 16 | * debian package version coresponds to github release now 17 | 18 | -- root Fri, 08 Oct 2010 17:19:10 +0200 19 | 20 | libmogilefs-perl (1.00-1kwick1) lenny; urgency=low 21 | 22 | * Non-maintainer upload. 23 | * SVN snapshot of 06 Oct 2010 24 | 25 | -- root Thu, 07 Oct 2010 17:43:59 +0200 26 | 27 | libmogilefs-perl (1.00-1) unstable; urgency=low 28 | 29 | * Initial release 30 | 31 | -- Jay Bonci Fri, 14 Jan 2005 15:05:21 -0500 32 | -------------------------------------------------------------------------------- /debian/compat: -------------------------------------------------------------------------------- 1 | 4 2 | -------------------------------------------------------------------------------- /debian/control: -------------------------------------------------------------------------------- 1 | Source: libmogilefs-perl 2 | Section: perl 3 | Priority: optional 4 | Maintainer: Jay Bonci 5 | Build-Depends-Indep: debhelper (>= 4.1.40), perl (>= 5.6.0-16), libio-stringy-perl, libwww-perl 6 | Standards-Version: 3.6.1.0 7 | 8 | Package: libmogilefs-perl 9 | Architecture: all 10 | Depends: ${perl:Depends}, libio-stringy-perl, libwww-perl 11 | Description: perl client for MogileFS 12 | MogileFS.pm provides a perl client for the MogileFS application-level 13 | distributed filesystem. 14 | -------------------------------------------------------------------------------- /debian/copyright: -------------------------------------------------------------------------------- 1 | This package was debianized by Jay Bonci on 2 | Fri Jan 14 15:08:23 EST 2005 3 | 4 | It was downloaded from: http://www.danga.com/dist/MogileFS/client-perl/ 5 | 6 | Upstream Authors: 7 | 8 | Brad Whitaker 9 | Brad Fitzpatrick 10 | 11 | 12 | Copyright: 13 | This program is free software; you can redistribute it and/or modify 14 | it under the terms of either: 15 | 16 | a) the GNU General Public License as published by the Free 17 | Software Foundation; either version 1, or (at your option) any 18 | later version, or 19 | 20 | b) the "Artistic License" 21 | 22 | See: 23 | 24 | /usr/share/common-licenses/Artistic 25 | /usr/share/common-licenses/GPL 26 | 27 | For more information regarding these licensing options 28 | -------------------------------------------------------------------------------- /debian/libmogilefs-perl.install: -------------------------------------------------------------------------------- 1 | usr/share/perl5 /usr/share 2 | usr/share/man/man3 /usr/share/man 3 | -------------------------------------------------------------------------------- /debian/rules: -------------------------------------------------------------------------------- 1 | #!/usr/bin/make -f 2 | # Sample debian/rules that uses debhelper. 3 | # GNU copyright 1997 to 1999 by Joey Hess. 4 | 5 | # Uncomment this to turn on verbose mode. 6 | #export DH_VERBOSE=1 7 | 8 | # This is the debhelper compatibility version to use. 9 | # export DH_COMPAT=4 10 | 11 | TMP =$(CURDIR)/debian/tmp 12 | 13 | 14 | build: build-stamp 15 | build-stamp: 16 | dh_testdir 17 | # Add here commands to compile the package. 18 | perl Makefile.PL verbose INSTALLDIRS=vendor 19 | $(MAKE) 20 | touch build-stamp 21 | 22 | clean: 23 | dh_testdir 24 | dh_testroot 25 | 26 | -$(MAKE) clean 27 | rm -f Makefile.old 28 | dh_clean build-stamp install-stamp 29 | 30 | install: build install-stamp 31 | install-stamp: 32 | dh_testdir 33 | dh_testroot 34 | dh_clean -k 35 | dh_installdirs 36 | 37 | $(MAKE) pure_install DESTDIR=$(TMP) PREFIX=/usr 38 | 39 | touch install-stamp 40 | 41 | binary-arch:; 42 | binary-indep: build install 43 | dh_testdir 44 | dh_testroot 45 | dh_installdocs 46 | dh_installman 47 | dh_installchangelogs 48 | dh_install --sourcedir=$(TMP) --fail-missing 49 | dh_link 50 | dh_strip 51 | dh_compress 52 | dh_fixperms 53 | dh_installdeb 54 | dh_perl 55 | dh_gencontrol 56 | dh_md5sums 57 | dh_builddeb 58 | 59 | binary: binary-indep binary-arch 60 | .PHONY: build clean binary-indep binary-arch binary install configure 61 | -------------------------------------------------------------------------------- /debian/watch: -------------------------------------------------------------------------------- 1 | version=2 2 | http://www.danga.com/dist/MogileFS/client-perl/MogileFS-([0-9].*)\.tar.gz 3 | -------------------------------------------------------------------------------- /lib/MogileFS/Admin.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::Admin; 2 | use strict; 3 | use Carp; 4 | use MogileFS::Backend; 5 | use fields qw(backend readonly); 6 | 7 | sub new { 8 | my MogileFS::Admin $self = shift; 9 | $self = fields::new($self) unless ref $self; 10 | 11 | my %args = @_; 12 | 13 | $self->{readonly} = $args{readonly} ? 1 : 0; 14 | my %backend_args = ( hosts => $args{hosts} ); 15 | $backend_args{timeout} = $args{timeout} if $args{timeout}; 16 | $self->{backend} = MogileFS::Backend->new( %backend_args ) 17 | or _fail("couldn't instantiate MogileFS::Backend"); 18 | 19 | return $self; 20 | } 21 | 22 | sub readonly { 23 | my MogileFS::Admin $self = shift; 24 | return $self->{readonly} = $_[0] ? 1 : 0 if @_; 25 | return $self->{readonly}; 26 | } 27 | 28 | sub replicate_now { 29 | my MogileFS::Admin $self = shift; 30 | 31 | my $res = $self->{backend}->do_request("replicate_now", {}) 32 | or return undef; 33 | return 1; 34 | } 35 | 36 | sub get_hosts { 37 | my MogileFS::Admin $self = shift; 38 | my $hostid = shift; 39 | 40 | my $args = $hostid ? { hostid => $hostid } : {}; 41 | my $res = $self->{backend}->do_request("get_hosts", $args) 42 | or return undef; 43 | 44 | my @ret = (); 45 | foreach my $ct (1..$res->{hosts}) { 46 | push @ret, { map { $_ => $res->{"host${ct}_$_"} } 47 | qw(hostid status hostname hostip http_port http_get_port altip altmask) }; 48 | } 49 | 50 | return \@ret; 51 | } 52 | 53 | sub get_devices { 54 | my MogileFS::Admin $self = shift; 55 | my $devid = shift; 56 | 57 | my $args = $devid ? { devid => $devid } : {}; 58 | my $res = $self->{backend}->do_request("get_devices", $args) 59 | or return undef; 60 | 61 | my @ret = (); 62 | foreach my $ct (1..$res->{devices}) { 63 | push @ret, { (map { $_ => $res->{"dev${ct}_$_"} } qw(devid hostid status observed_state utilization)), 64 | (map { $_ => $res->{"dev${ct}_$_"}+0 } qw(mb_total mb_used weight)) }; 65 | } 66 | 67 | return \@ret; 68 | 69 | } 70 | 71 | # get raw information about fids, for enumerating the dataset 72 | # ( $from_fid, $count ) 73 | # returns: 74 | # { fid => { hashref with keys: domain, class, devcount, length, key } } 75 | sub list_fids { 76 | my MogileFS::Admin $self = shift; 77 | my ($fromfid, $count) = @_; 78 | 79 | my $res = $self->{backend}->do_request('list_fids', { from => $fromfid, to => $count }) 80 | or return undef; 81 | 82 | my $ret = {}; 83 | foreach my $i (1..$res->{fid_count}) { 84 | $ret->{$res->{"fid_${i}_fid"}} = { 85 | key => $res->{"fid_${i}_key"}, 86 | length => $res->{"fid_${i}_length"}, 87 | class => $res->{"fid_${i}_class"}, 88 | domain => $res->{"fid_${i}_domain"}, 89 | devcount => $res->{"fid_${i}_devcount"}, 90 | }; 91 | } 92 | return $ret; 93 | } 94 | 95 | sub clear_cache { 96 | my MogileFS::Admin $self = shift; 97 | # do the request, default to request all stats if they didn't specify any 98 | push @_, 'all' unless @_; 99 | my $res = $self->{backend}->do_request("clear_cache", { map { $_ => 1 } @_ }) 100 | or return undef; 101 | return 1; 102 | } 103 | 104 | # get a hashref of the domains we know about in the format of 105 | # { domain_name => { class_name => mindevcount, class_name => mindevcount, ... }, ... } 106 | sub get_domains { 107 | my MogileFS::Admin $self = shift; 108 | 109 | my $res = $self->{backend}->do_request("get_domains", {}) 110 | or return undef; 111 | 112 | my $ret = {}; 113 | foreach my $i (1..$res->{domains}) { 114 | $ret->{$res->{"domain$i"}} = { 115 | map { 116 | $res->{"domain${i}class${_}name"} => 117 | { mindevcount => $res->{"domain${i}class${_}mindevcount"}, 118 | replpolicy => $res->{"domain${i}class${_}replpolicy"} || '', 119 | hashtype => $res->{"domain${i}class${_}hashtype"} || '', 120 | } 121 | } (1..$res->{"domain${i}classes"}) 122 | }; 123 | } 124 | 125 | return $ret; 126 | } 127 | 128 | # create a new domain 129 | sub create_domain { 130 | my MogileFS::Admin $self = shift; 131 | return undef if $self->{readonly}; 132 | 133 | my $domain = shift; 134 | 135 | my $res = $self->{backend}->do_request("create_domain", { domain => $domain }); 136 | return undef unless $res->{domain} eq $domain; 137 | 138 | return 1; 139 | } 140 | 141 | # delete a domain 142 | sub delete_domain { 143 | my MogileFS::Admin $self = shift; 144 | return undef if $self->{readonly}; 145 | 146 | my $domain = shift; 147 | 148 | $self->{backend}->do_request("delete_domain", { domain => $domain }) 149 | or return undef; 150 | 151 | return 1; 152 | } 153 | 154 | # create a class within a domain 155 | sub create_class { 156 | my MogileFS::Admin $self = shift; 157 | 158 | # wrapper around _mod_class(create) 159 | return $self->_mod_class(@_, 'create'); 160 | } 161 | 162 | 163 | # update a class's mindevcount within a domain 164 | sub update_class { 165 | my MogileFS::Admin $self = shift; 166 | 167 | # wrapper around _mod_class(update) 168 | return $self->_mod_class(@_, 'update'); 169 | } 170 | 171 | # delete a class 172 | sub delete_class { 173 | my MogileFS::Admin $self = shift; 174 | return undef if $self->{readonly}; 175 | 176 | my ($domain, $class) = @_; 177 | 178 | $self->{backend}->do_request("delete_class", { 179 | domain => $domain, 180 | class => $class, 181 | }) or return undef; 182 | 183 | return 1; 184 | } 185 | 186 | 187 | # create a host 188 | sub create_host { 189 | my MogileFS::Admin $self = shift; 190 | my $host = shift; 191 | return undef unless $host; 192 | 193 | my $args = shift; 194 | return undef unless ref $args eq 'HASH'; 195 | return undef unless $args->{ip} && $args->{port}; 196 | 197 | return $self->_mod_host($host, $args, 'create'); 198 | } 199 | 200 | # edit a host 201 | sub update_host { 202 | my MogileFS::Admin $self = shift; 203 | my $host = shift; 204 | return undef unless $host; 205 | 206 | my $args = shift; 207 | return undef unless ref $args eq 'HASH'; 208 | 209 | return $self->_mod_host($host, $args, 'update'); 210 | } 211 | 212 | # delete a host 213 | sub delete_host { 214 | my MogileFS::Admin $self = shift; 215 | return undef if $self->{readonly}; 216 | 217 | my $host = shift; 218 | return undef unless $host; 219 | 220 | $self->{backend}->do_request("delete_host", { host => $host }) 221 | or return undef; 222 | return 1; 223 | } 224 | 225 | # create a new device 226 | sub create_device { 227 | my MogileFS::Admin $self = shift; 228 | return undef if $self->{readonly}; 229 | 230 | my (%opts) = @_; #hostname or hostid, devid, state (optional) 231 | 232 | my $res = $self->{backend}->do_request("create_device", \%opts) 233 | or return undef; 234 | 235 | return 1; 236 | } 237 | 238 | # edit a device 239 | sub update_device { 240 | my MogileFS::Admin $self = shift; 241 | return undef if $self->{readonly}; 242 | my $host = shift; 243 | my $device = shift; 244 | return undef unless $host; 245 | return undef unless $device; 246 | 247 | my $args = shift; 248 | return undef unless ref $args eq 'HASH'; 249 | 250 | # TODO: provide a native update_device in the MogileFS::Admin command set. 251 | if ($args->{status}){ 252 | $self->change_device_state($host, $device, $args->{status}) or return undef; 253 | } 254 | if ($args->{weight}){ 255 | $self->change_device_weight($host, $device, $args->{weight}) or return undef; 256 | } 257 | 258 | return 1; 259 | } 260 | 261 | # change the state of a device; pass in the hostname of the host the 262 | # device is located on, the device id number, and the state you want 263 | # the host to be set to. returns 1 on success, undef on error. 264 | sub change_device_state { 265 | my MogileFS::Admin $self = shift; 266 | return undef if $self->{readonly}; 267 | 268 | my ($host, $device, $state) = @_; 269 | 270 | my $res = $self->{backend}->do_request("set_state", { 271 | host => $host, 272 | device => $device, 273 | state => $state, 274 | }) or return undef; 275 | 276 | return 1; 277 | } 278 | 279 | # change the weight of a device by passing in the hostname and 280 | # the device id 281 | sub change_device_weight { 282 | my MogileFS::Admin $self = shift; 283 | return undef if $self->{readonly}; 284 | 285 | my ($host, $device, $weight) = @_; 286 | $weight += 0; 287 | 288 | my $res = $self->{backend}->do_request("set_weight", { 289 | host => $host, 290 | device => $device, 291 | weight => $weight, 292 | }) or return undef; 293 | 294 | return 1; 295 | } 296 | 297 | # returns a hash (list) of key => weight 298 | sub _get_slave_keys { 299 | my MogileFS::Admin $self = shift; 300 | my $backend = $self->{backend}; 301 | 302 | my $keys_res = $backend->do_request("server_setting", { 303 | key => "slave_keys", 304 | }); 305 | 306 | return () unless $keys_res; 307 | 308 | my %slave_keys; 309 | 310 | foreach my $slave (split /,/, $keys_res->{value}) { 311 | my ($key, $weight) = split /=/, $slave, 2; 312 | 313 | # Weight can be zero, so don't default to 1 if it's defined and longer than 0 characters. 314 | unless (defined $weight && length $weight) { 315 | $weight = 1; 316 | } 317 | 318 | $slave_keys{$key} = $weight; 319 | } 320 | 321 | return %slave_keys; 322 | } 323 | 324 | # returns a hash (list) of key => options 325 | sub _set_slave_keys { 326 | my MogileFS::Admin $self = shift; 327 | my $backend = $self->{backend}; 328 | 329 | my %slave_keys = @_; 330 | 331 | my @keys; 332 | 333 | foreach my $key (keys %slave_keys) { 334 | my $weight = $slave_keys{$key}; 335 | if (defined $weight && length $weight && $weight != 1) { 336 | $key .= "=$weight"; 337 | } 338 | push @keys, $key; 339 | } 340 | 341 | my $keys_res = $backend->do_request("set_server_setting", { 342 | key => "slave_keys", 343 | value => join(',', @keys), 344 | }); 345 | 346 | return 0 unless $keys_res; 347 | return 1; 348 | } 349 | 350 | # returns a hashref of key => [dsn, username, password] specifying slave nodes which can be connected to. 351 | sub slave_list { 352 | my MogileFS::Admin $self = shift; 353 | 354 | my $backend = $self->{backend}; 355 | 356 | my %slave_keys = $self->_get_slave_keys; 357 | my %return; 358 | 359 | foreach my $key (keys %slave_keys) { 360 | my $slave_res = $backend->do_request("server_setting", { 361 | key => "slave_$key", 362 | }); 363 | next unless $slave_res; 364 | my ($dsn, $username, $password) = split /\|/, $slave_res->{value}; 365 | $return{$key} = [$dsn, $username, $password]; 366 | } 367 | 368 | return \%return; 369 | } 370 | 371 | sub slave_add { 372 | my MogileFS::Admin $self = shift; 373 | my ($key, $dsn, $username, $password) = @_; 374 | 375 | my $backend = $self->{backend}; 376 | 377 | my %slave_keys = $self->_get_slave_keys; 378 | 379 | if (exists $slave_keys{$key}) { 380 | return 0; 381 | } 382 | 383 | my $res = $backend->do_request("set_server_setting", { 384 | key => "slave_$key", 385 | value => join('|', $dsn, $username, $password), 386 | }) or return undef; 387 | 388 | $slave_keys{$key} = undef; 389 | 390 | $self->_set_slave_keys(%slave_keys); 391 | 392 | return 1; 393 | } 394 | 395 | sub slave_modify { 396 | my MogileFS::Admin $self = shift; 397 | my $key = shift; 398 | my %opts = @_; 399 | 400 | my $backend = $self->{backend}; 401 | 402 | my %slave_keys = $self->_get_slave_keys; 403 | 404 | unless (exists $slave_keys{$key}) { 405 | return 0; 406 | } 407 | 408 | my $get_res = $backend->do_request("server_setting", { 409 | key => "slave_$key", 410 | }) or return undef; 411 | 412 | my ($dsn, $username, $password) = split /\|/, $get_res->{value}; 413 | 414 | $dsn = $opts{dsn} if exists $opts{dsn}; 415 | $username = $opts{username} if exists $opts{username}; 416 | $password = $opts{password} if exists $opts{password}; 417 | 418 | my $set_res = $backend->do_request("set_server_setting", { 419 | key => "slave_$key", 420 | value => join('|', $dsn, $username, $password), 421 | }) or return undef; 422 | 423 | return 1; 424 | } 425 | 426 | sub slave_delete { 427 | my MogileFS::Admin $self = shift; 428 | my $key = shift; 429 | 430 | my $backend = $self->{backend}; 431 | 432 | my %slave_keys = $self->_get_slave_keys; 433 | 434 | unless (exists $slave_keys{$key}) { 435 | return 0; 436 | } 437 | 438 | my $res = $backend->do_request("set_server_setting", { 439 | key => "slave_$key", 440 | value => undef, 441 | }) or return undef; 442 | 443 | delete $slave_keys{$key}; 444 | 445 | $self->_set_slave_keys(%slave_keys); 446 | 447 | return 1; 448 | } 449 | 450 | sub fsck_start { 451 | my MogileFS::Admin $self = shift; 452 | return $self->{backend}->do_request("fsck_start", {}); 453 | } 454 | 455 | sub fsck_stop { 456 | my MogileFS::Admin $self = shift; 457 | return $self->{backend}->do_request("fsck_stop", {}); 458 | } 459 | 460 | sub fsck_reset { 461 | my MogileFS::Admin $self = shift; 462 | my %opts = @_; 463 | my $polonly = delete $opts{policy_only}; 464 | my $startpos = delete $opts{startpos}; 465 | Carp::croak("Unknown options: ". join(", ", keys %opts)) if %opts; 466 | return $self->{backend}->do_request("fsck_reset", { 467 | policy_only => $polonly, 468 | startpos => $startpos, 469 | }); 470 | } 471 | 472 | sub fsck_clearlog { 473 | my MogileFS::Admin $self = shift; 474 | return $self->{backend}->do_request("fsck_clearlog", {}); 475 | } 476 | 477 | sub fsck_status { 478 | my MogileFS::Admin $self = shift; 479 | return $self->{backend}->do_request("fsck_status", {}); 480 | } 481 | 482 | sub fsck_log_rows { 483 | my MogileFS::Admin $self = shift; 484 | my %args = @_; 485 | my $after = delete $args{after_logid}; 486 | die if %args; 487 | 488 | my $ret = $self->{backend}->do_request("fsck_getlog", { 489 | after_logid => $after, 490 | }); 491 | my @ret; 492 | for (my $i = 1; $i <= $ret->{row_count}; $i++) { 493 | my $rec = {}; 494 | foreach my $k (qw(logid utime fid evcode devid)) { 495 | $rec->{$k} = $ret->{"row_${i}_$k"}; 496 | } 497 | push @ret, $rec; 498 | } 499 | return @ret; 500 | } 501 | 502 | sub set_server_setting { 503 | my MogileFS::Admin $self = shift; 504 | my ($key, $val) = @_; 505 | my $res = $self->{backend}->do_request("set_server_setting", { 506 | key => $key, 507 | value => $val, 508 | }); 509 | return 0 unless $res; 510 | return 1; 511 | } 512 | 513 | sub server_settings { 514 | my MogileFS::Admin $self = shift; 515 | my ($key, $val) = @_; 516 | my $res = $self->{backend}->do_request("server_settings", {}); 517 | return 0 unless $res; 518 | my $ret = {}; 519 | for (my $i = 1; $i <= $res->{key_count}; $i++) { 520 | $ret->{$res->{"key_$i"}} = $res->{"value_$i"}; 521 | } 522 | return $ret; 523 | } 524 | 525 | sub rebalance_status { 526 | my MogileFS::Admin $self = shift; 527 | return $self->{backend}->do_request("rebalance_status", {}); 528 | } 529 | 530 | sub rebalance_start { 531 | my MogileFS::Admin $self = shift; 532 | return $self->{backend}->do_request("rebalance_start", {}); 533 | } 534 | 535 | sub rebalance_test { 536 | my MogileFS::Admin $self = shift; 537 | return $self->{backend}->do_request("rebalance_test", {}); 538 | } 539 | 540 | sub rebalance_stop { 541 | my MogileFS::Admin $self = shift; 542 | return $self->{backend}->do_request("rebalance_stop", {}); 543 | } 544 | 545 | sub rebalance_reset { 546 | my MogileFS::Admin $self = shift; 547 | return $self->{backend}->do_request("rebalance_reset", {}); 548 | } 549 | 550 | sub rebalance_set_policy { 551 | my MogileFS::Admin $self = shift; 552 | 553 | my $policy = shift; 554 | return $self->{backend}->do_request("rebalance_set_policy", { 555 | policy => $policy, 556 | }); 557 | } 558 | 559 | ################################################################################ 560 | # MogileFS::Admin class methods 561 | # 562 | 563 | sub _fail { 564 | croak "MogileFS::Admin: $_[0]"; 565 | } 566 | 567 | # FIXME: is this used? 568 | sub _debug { 569 | return 1 unless $MogileFS::DEBUG; 570 | my $msg = shift; 571 | my $ref = shift; 572 | chomp $msg; 573 | eval "use Data::Dumper;"; 574 | print STDERR "$msg\n" . Dumper($ref) . "\n"; 575 | return 1; 576 | } 577 | 578 | # modify a class within a domain 579 | sub _mod_class { 580 | my MogileFS::Admin $self = shift; 581 | return undef if $self->{readonly}; 582 | 583 | my ($domain, $class, $args, $verb) = @_; 584 | $verb ||= 'create'; 585 | 586 | my $res = $self->{backend}->do_request("${verb}_class", { 587 | domain => $domain, 588 | class => $class, 589 | %$args, 590 | }); 591 | return undef unless $res->{class} eq $class; 592 | 593 | return 1; 594 | } 595 | 596 | # modify a host 597 | sub _mod_host { 598 | my MogileFS::Admin $self = shift; 599 | return undef if $self->{readonly}; 600 | 601 | my ($host, $args, $verb) = @_; 602 | 603 | $args ||= {}; 604 | $args->{host} = $host; 605 | $verb ||= 'create'; 606 | 607 | my $res = $self->{backend}->do_request("${verb}_host", $args); 608 | return undef unless $res->{host} eq $host; 609 | 610 | return 1; 611 | } 612 | 613 | sub errstr { 614 | my MogileFS::Admin $self = shift; 615 | return undef unless $self->{backend}; 616 | return $self->{backend}->errstr; 617 | } 618 | 619 | sub errcode { 620 | my MogileFS::Admin $self = shift; 621 | return undef unless $self->{backend}; 622 | return $self->{backend}->errcode; 623 | } 624 | 625 | sub err { 626 | my MogileFS::Admin $self = shift; 627 | return undef unless $self->{backend}; 628 | return $self->{backend}->err; 629 | } 630 | 631 | 1; 632 | -------------------------------------------------------------------------------- /lib/MogileFS/Backend.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::Backend; 2 | 3 | use strict; 4 | no strict 'refs'; 5 | 6 | use Carp; 7 | use IO::Socket::INET; 8 | use Socket qw( MSG_NOSIGNAL PF_INET IPPROTO_TCP SOCK_STREAM ); 9 | use Errno qw( EINPROGRESS EWOULDBLOCK EISCONN ); 10 | use POSIX (); 11 | use MogileFS::Client; 12 | use List::Util qw/ shuffle /; 13 | 14 | use fields ('hosts', # arrayref of "$host:$port" of mogilefsd servers 15 | 'host_dead', # "$host:$port" -> $time (of last connect failure) 16 | 'lasterr', # string: \w+ identifier of last error 17 | 'lasterrstr', # string: english of last error 18 | 'sock_cache', # cached socket to mogilefsd tracker 19 | 'pref_ip', # hashref; { ip => preferred ip } 20 | 'timeout', # time in seconds to allow sockets to become readable 21 | 'last_host_connected', # "ip:port" of last host connected to 22 | 'last_host_idx', # array index of the last host we connected to 23 | 'hooks', # hash: hookname -> coderef 24 | ); 25 | 26 | use vars qw($FLAG_NOSIGNAL $PROTO_TCP); 27 | eval { $FLAG_NOSIGNAL = MSG_NOSIGNAL; }; 28 | 29 | sub new { 30 | my MogileFS::Backend $self = shift; 31 | $self = fields::new($self) unless ref $self; 32 | 33 | return $self->_init(@_); 34 | } 35 | 36 | sub reload { 37 | my MogileFS::Backend $self = shift; 38 | return undef unless $self; 39 | 40 | return $self->_init(@_); 41 | } 42 | 43 | sub _init { 44 | my MogileFS::Backend $self = shift; 45 | 46 | my %args = @_; 47 | 48 | # FIXME: add actual validation 49 | { 50 | $self->{hosts} = $args{hosts} or 51 | _fail("constructor requires parameter 'hosts'"); 52 | 53 | _fail("'hosts' argument must be an arrayref") 54 | unless ref $self->{hosts} eq 'ARRAY'; 55 | 56 | _fail("'hosts' argument must be of form: 'host:port'") 57 | if grep(! /:\d+$/, @{$self->{hosts}}); 58 | 59 | _fail("'timeout' argument must be a number") 60 | if $args{timeout} && $args{timeout} !~ /^\d+$/; 61 | $self->{timeout} = $args{timeout} || 3; 62 | } 63 | 64 | $self->{hosts} = [ shuffle(@{ $self->{hosts} }) ]; 65 | 66 | $self->{host_dead} = {}; 67 | 68 | return $self; 69 | } 70 | 71 | sub run_hook { 72 | my MogileFS::Backend $self = shift; 73 | my $hookname = shift || return; 74 | 75 | my $hook = $self->{hooks}->{$hookname}; 76 | return unless $hook; 77 | 78 | eval { $hook->(@_) }; 79 | 80 | warn "MogileFS::Backend hook '$hookname' threw error: $@\n" if $@; 81 | } 82 | 83 | sub add_hook { 84 | my MogileFS::Backend $self = shift; 85 | my $hookname = shift || return; 86 | 87 | if (@_) { 88 | $self->{hooks}->{$hookname} = shift; 89 | } else { 90 | delete $self->{hooks}->{$hookname}; 91 | } 92 | } 93 | 94 | sub set_pref_ip { 95 | my MogileFS::Backend $self = shift; 96 | $self->{pref_ip} = shift; 97 | $self->{pref_ip} = undef 98 | unless $self->{pref_ip} && 99 | ref $self->{pref_ip} eq 'HASH'; 100 | } 101 | 102 | sub _wait_for_readability { 103 | my ($fileno, $timeout) = @_; 104 | return 0 unless $fileno && $timeout; 105 | 106 | my $rin = ''; 107 | vec($rin, $fileno, 1) = 1; 108 | # FIXME: signals/ptrace attach can interrupt the select. we should resume selecting 109 | # and keep track of hires time remaining 110 | my $nfound = select($rin, undef, undef, $timeout); 111 | 112 | # undef/0 are failure, 1 is success 113 | return $nfound ? 1 : 0; 114 | } 115 | 116 | sub do_request { 117 | my MogileFS::Backend $self = shift; 118 | my ($cmd, $args) = @_; 119 | 120 | _fail("invalid arguments to do_request") 121 | unless $cmd && $args; 122 | 123 | local $SIG{'PIPE'} = "IGNORE" unless $FLAG_NOSIGNAL; 124 | 125 | my $sock = $self->{sock_cache}; 126 | my $argstr = _encode_url_string(%$args); 127 | my $req = "$cmd $argstr\r\n"; 128 | my $reqlen = length($req); 129 | my $rv = 0; 130 | 131 | if ($sock) { 132 | # try our cached one, but assume it might be bogus 133 | $self->run_hook('do_request_start', $cmd, $self->{last_host_connected}); 134 | _debug("SOCK: cached = $sock, REQ: $req"); 135 | $rv = send($sock, $req, $FLAG_NOSIGNAL); 136 | if ($! || ! defined $rv) { 137 | # undef is error, but $! may not be populated, we've found 138 | $self->run_hook('do_request_send_error', $cmd, $self->{last_host_connected}); 139 | undef $self->{sock_cache}; 140 | } elsif ($rv != $reqlen) { 141 | $self->run_hook('do_request_length_mismatch', $cmd, $self->{last_host_connected}); 142 | return _fail("send() didn't return expected length ($rv, not $reqlen)"); 143 | } 144 | } 145 | 146 | unless ($rv) { 147 | $sock = $self->_get_sock 148 | or return _fail("couldn't connect to mogilefsd backend"); 149 | $self->run_hook('do_request_start', $cmd, $self->{last_host_connected}); 150 | _debug("SOCK: $sock, REQ: $req"); 151 | $rv = send($sock, $req, $FLAG_NOSIGNAL); 152 | if ($!) { 153 | $self->run_hook('do_request_send_error', $cmd, $self->{last_host_connected}); 154 | return _fail("error talking to mogilefsd tracker: $!"); 155 | } elsif ($rv != $reqlen) { 156 | $self->run_hook('do_request_length_mismatch', $cmd, $self->{last_host_connected}); 157 | return _fail("send() didn't return expected length ($rv, not $reqlen)"); 158 | } 159 | $self->{sock_cache} = $sock; 160 | } 161 | 162 | # wait up to 3 seconds for the socket to come to life 163 | unless (_wait_for_readability(fileno($sock), $self->{timeout})) { 164 | close($sock); 165 | $self->run_hook('do_request_read_timeout', $cmd, $self->{last_host_connected}); 166 | undef $self->{sock_cache}; 167 | return _fail("timed out after $self->{timeout}s against $self->{last_host_connected} when sending command: [$req]"); 168 | } 169 | 170 | # guard against externally-modified $/ changes. patch from 171 | # Andreas J. Koenig. in practice nobody should do this, though, 172 | # and this line should be unnecessary. 173 | local $/ = "\n"; 174 | 175 | my $line = <$sock>; 176 | 177 | $self->run_hook('do_request_finished', $cmd, $self->{last_host_connected}); 178 | 179 | _debug("RESPONSE: $line"); 180 | 181 | unless (defined $line) { 182 | undef $self->{sock_cache}; 183 | return _fail("socket closed on read"); 184 | } 185 | 186 | # ERR 187 | if ($line =~ /^ERR\s+(\w+)\s*(\S*)/) { 188 | $self->{'lasterr'} = $1; 189 | $self->{'lasterrstr'} = $2 ? _unescape_url_string($2) : undef; 190 | _debug("LASTERR: $1 $2"); 191 | return undef; 192 | } 193 | 194 | # OK 195 | if ($line =~ /^OK\s+\d*\s*(\S*)/) { 196 | my $args = _decode_url_string($1); 197 | _debug("RETURN_VARS: ", $args); 198 | return $args; 199 | } 200 | 201 | undef $self->{sock_cache}; 202 | _fail("invalid response from server: [$line]"); 203 | return undef; 204 | } 205 | 206 | sub errstr { 207 | my MogileFS::Backend $self = shift; 208 | return unless $self->{'lasterr'}; 209 | return join(" ", $self->{'lasterr'}, $self->{'lasterrstr'}); 210 | } 211 | 212 | sub errcode { 213 | my MogileFS::Backend $self = shift; 214 | return $self->{lasterr}; 215 | } 216 | 217 | sub last_tracker { 218 | my $self = shift; 219 | return $self->{last_host_connected}; 220 | } 221 | 222 | sub err { 223 | my MogileFS::Backend $self = shift; 224 | return $self->{lasterr} ? 1 : 0; 225 | } 226 | 227 | sub force_disconnect { 228 | my MogileFS::Backend $self = shift; 229 | undef $self->{sock_cache}; 230 | return; 231 | } 232 | 233 | ################################################################################ 234 | # MogileFS::Backend class methods 235 | # 236 | 237 | sub _fail { 238 | croak "MogileFS::Backend: $_[0]"; 239 | } 240 | 241 | *_debug = *MogileFS::Client::_debug; 242 | 243 | sub _connect_sock { # sock, sin, timeout 244 | my ($sock, $sin, $timeout) = @_; 245 | $timeout ||= 0.25; 246 | 247 | # make the socket non-blocking for the connection if wanted, but 248 | # unconditionally set it back to blocking mode at the end 249 | 250 | if ($timeout) { 251 | IO::Handle::blocking($sock, 0); 252 | } else { 253 | IO::Handle::blocking($sock, 1); 254 | } 255 | 256 | my $ret = connect($sock, $sin); 257 | 258 | if (!$ret && $timeout && $!==EINPROGRESS) { 259 | 260 | my $win=''; 261 | vec($win, fileno($sock), 1) = 1; 262 | 263 | if (select(undef, $win, undef, $timeout) > 0) { 264 | $ret = connect($sock, $sin); 265 | # EISCONN means connected & won't re-connect, so success 266 | $ret = 1 if !$ret && $!==EISCONN; 267 | } 268 | } 269 | 270 | # turn blocking back on, as we expect to do blocking IO on our sockets 271 | IO::Handle::blocking($sock, 1) if $timeout; 272 | 273 | return $ret; 274 | } 275 | 276 | sub _sock_to_host { # (host) 277 | my MogileFS::Backend $self = shift; 278 | my $host = shift; 279 | 280 | # create a socket and try to do a non-blocking connect 281 | my ($ip, $port) = $host =~ /^(.*):(\d+)$/; 282 | my $sock = "Sock_$host"; 283 | my $connected = 0; 284 | my $proto = $PROTO_TCP ||= getprotobyname('tcp'); 285 | my $sin; 286 | 287 | # try preferred ips 288 | if ($self->{pref_ip} && (my $prefip = $self->{pref_ip}->{$ip})) { 289 | _debug("using preferred ip $prefip over $ip"); 290 | socket($sock, PF_INET, SOCK_STREAM, $proto); 291 | $sin = Socket::sockaddr_in($port, Socket::inet_aton($prefip)); 292 | if (_connect_sock($sock, $sin, 0.1)) { 293 | $connected = 1; 294 | $self->{last_host_connected} = "$prefip:$port"; 295 | } else { 296 | _debug("failed connect to preferred ip $prefip"); 297 | close $sock; 298 | } 299 | } 300 | 301 | # now try the original ip 302 | unless ($connected) { 303 | socket($sock, PF_INET, SOCK_STREAM, $proto); 304 | my $aton_ip = Socket::inet_aton($ip) 305 | or return undef; 306 | $sin = Socket::sockaddr_in($port, $aton_ip); 307 | return undef unless _connect_sock($sock, $sin); 308 | $self->{last_host_connected} = $host; 309 | } 310 | 311 | # just throw back the socket we have so far 312 | return $sock; 313 | } 314 | 315 | # return a new mogilefsd socket, trying different hosts until one is found, 316 | # or undef if they're all dead 317 | sub _get_sock { 318 | my MogileFS::Backend $self = shift; 319 | return undef unless $self; 320 | 321 | my $size = scalar(@{$self->{hosts}}); 322 | my $tries = $size > 15 ? 15 : $size; 323 | 324 | unless (defined($self->{last_host_idx})) { 325 | $self->{last_host_idx} = int(rand() * $size); 326 | } 327 | 328 | my $now = time(); 329 | my $sock; 330 | foreach (1..$tries) { 331 | $self->{last_host_idx} = ($self->{last_host_idx}+1) % $size; 332 | my $host = $self->{hosts}->[$self->{last_host_idx}]; 333 | 334 | # try dead hosts every 5 seconds 335 | next if $self->{host_dead}->{$host} && 336 | $self->{host_dead}->{$host} > $now - 5; 337 | 338 | last if $sock = $self->_sock_to_host($host); 339 | 340 | # mark sock as dead 341 | _debug("marking host dead: $host @ $now"); 342 | $self->{host_dead}->{$host} = $now; 343 | } 344 | 345 | return $sock; 346 | } 347 | 348 | sub _escape_url_string { 349 | my $str = shift; 350 | $str =~ s/([^a-zA-Z0-9_\,\-.\/\\\: ])/uc sprintf("%%%02x",ord($1))/eg; 351 | $str =~ tr/ /+/; 352 | return $str; 353 | } 354 | 355 | sub _unescape_url_string { 356 | my $str = shift; 357 | $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 358 | $str =~ tr/+/ /; 359 | return $str; 360 | } 361 | 362 | sub _encode_url_string { 363 | my %args = @_; 364 | return "" unless %args; 365 | return join("&", 366 | map { _escape_url_string($_) . '=' . 367 | _escape_url_string($args{$_}) } 368 | grep { defined $args{$_} } keys %args 369 | ); 370 | } 371 | 372 | sub _decode_url_string { 373 | my $arg = shift; 374 | my $buffer = ref $arg ? $arg : \$arg; 375 | my $hashref = {}; # output hash 376 | 377 | my $pair; 378 | my @pairs = split(/&/, $$buffer); 379 | my ($name, $value); 380 | foreach $pair (@pairs) { 381 | ($name, $value) = split(/=/, $pair); 382 | $value =~ tr/+/ /; 383 | $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 384 | $name =~ tr/+/ /; 385 | $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 386 | $hashref->{$name} .= $hashref->{$name} ? "\0$value" : $value; 387 | } 388 | 389 | return $hashref; 390 | } 391 | 392 | 1; 393 | -------------------------------------------------------------------------------- /lib/MogileFS/Client.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | package MogileFS::Client; 3 | 4 | =head1 NAME 5 | 6 | MogileFS::Client - Client library for the MogileFS distributed file system. 7 | 8 | =head1 SYNOPSIS 9 | 10 | use MogileFS::Client; 11 | 12 | # create client object w/ server-configured namespace 13 | # and IPs of trackers 14 | $mogc = MogileFS::Client->new(domain => "foo.com::my_namespace", 15 | hosts => ['10.0.0.2:7001', '10.0.0.3:7001']); 16 | 17 | # create a file 18 | # mogile is a flat namespace. no paths. 19 | $key = "image_of_userid:$userid"; 20 | # must be configured on server 21 | $class = "user_images"; 22 | $fh = $mogc->new_file($key, $class); 23 | 24 | print $fh $data; 25 | 26 | unless ($fh->close) { 27 | die "Error writing file: " . $mogc->errcode . ": " . $mogc->errstr; 28 | } 29 | 30 | # Find the URLs that the file was replicated to. 31 | # May change over time. 32 | @urls = $mogc->get_paths($key); 33 | 34 | # no longer want it? 35 | $mogc->delete($key); 36 | 37 | =head1 DESCRIPTION 38 | 39 | This module is a client library for the MogileFS distributed file system. The class method 'new' creates a client object against a 40 | particular mogilefs tracker and domain. This object may then be used to store and retrieve content easily from MogileFS. 41 | 42 | =cut 43 | 44 | use strict; 45 | use Carp; 46 | use IO::WrapTie; 47 | use LWP::UserAgent; 48 | use fields ( 49 | 'domain', # scalar: the MogileFS domain (namespace). 50 | 'backend', # MogileFS::Backend object 51 | 'readonly', # bool: if set, client won't permit write actions/etc. just reads. 52 | 'hooks', # hash: hookname -> coderef 53 | ); 54 | use Time::HiRes (); 55 | use MogileFS::Backend; 56 | use MogileFS::NewHTTPFile; 57 | use MogileFS::ClientHTTPFile; 58 | 59 | our $VERSION = '1.16'; 60 | 61 | our $AUTOLOAD; 62 | 63 | =head1 METHODS 64 | 65 | =head2 new 66 | 67 | $client = MogileFS::Client->new( %OPTIONS ); 68 | 69 | Creates a new MogileFS::Client object. 70 | 71 | Returns MogileFS::Client object on success, or dies on failure. 72 | 73 | OPTIONS: 74 | 75 | =over 76 | 77 | =item hosts 78 | 79 | Arrayref of 'host:port' strings to connect to as backend trackers in this client. 80 | 81 | =item domain 82 | 83 | String representing the mogile domain which this MogileFS client is associated with. (All create/delete/fetch operations 84 | will be performed against this mogile domain). See the mogadm shell command and its 'domain' category of operations for 85 | information on manipulating the list of possible domains on a MogileFS system. 86 | 87 | =back 88 | 89 | =cut 90 | 91 | sub new { 92 | my MogileFS::Client $self = shift; 93 | $self = fields::new($self) unless ref $self; 94 | 95 | return $self->_init(@_); 96 | } 97 | 98 | =head2 reload 99 | 100 | $mogc->reload( %OPTIONS ) 101 | 102 | Re-init the object, like you'd just reconstructed it with 'new', but change it in-place instead. Useful if you have a system which reloads a config file, and you want to update a singleton $mogc handle's config value. 103 | 104 | =cut 105 | 106 | sub reload { 107 | my MogileFS::Client $self = shift; 108 | return undef unless $self; 109 | 110 | return $self->_init(@_); 111 | } 112 | 113 | sub _init { 114 | my MogileFS::Client $self = shift; 115 | 116 | my %args = @_; 117 | 118 | # FIXME: add actual validation 119 | { 120 | # by default, set readonly off 121 | $self->{readonly} = $args{readonly} ? 1 : 0; 122 | 123 | # get domain (required) 124 | $self->{domain} = $args{domain} or 125 | _fail("constructor requires parameter 'domain'"); 126 | 127 | # create a new backend object if there's not one already, 128 | # otherwise call a reload on the existing one 129 | if ($self->{backend}) { 130 | $self->{backend}->reload( hosts => $args{hosts} ); 131 | } else { 132 | $self->{backend} = MogileFS::Backend->new( hosts => $args{hosts}, 133 | timeout => $args{timeout}, 134 | ); 135 | } 136 | _fail("cannot instantiate MogileFS::Backend") unless $self->{backend}; 137 | } 138 | 139 | _debug("MogileFS object: [$self]", $self); 140 | 141 | return $self; 142 | } 143 | 144 | =head2 last_tracker 145 | 146 | Returns a scalar of form "ip:port", representing the last mogilefsd 147 | 'tracker' server which was talked to. 148 | 149 | =cut 150 | 151 | sub last_tracker { 152 | my MogileFS::Client $self = shift; 153 | return $self->{backend}->last_tracker; 154 | } 155 | 156 | =head2 errstr 157 | 158 | Returns string representation of the last error that occurred. It 159 | includes the error code (same as method 'errcode') and a space before 160 | the optional English error message. 161 | 162 | This isn't necessarily guaranteed to reset after a successful 163 | operation. Only call it after another operation returns an error. 164 | 165 | 166 | =cut 167 | 168 | sub errstr { 169 | my MogileFS::Client $self = shift; 170 | return $self->{backend}->errstr; 171 | } 172 | 173 | =head2 errcode 174 | 175 | Returns an error code. Not a number, but a string identifier 176 | (e.g. "no_domain") which is stable for use in error handling logic. 177 | 178 | This isn't necessarily guaranteed to reset after a successful 179 | operation. Only call it after another operation returns an error. 180 | 181 | =cut 182 | 183 | sub errcode { 184 | my MogileFS::Client $self = shift; 185 | return $self->{backend}->errcode; 186 | } 187 | 188 | =head2 force_disconnect 189 | 190 | Forces the client to disconnect from the tracker, causing it to reconnect 191 | when the next request is made. It will reconnect to a different tracker if 192 | possible. A paranoid application may wish to do to this before retrying a 193 | failed command, on the off chance that another tracker may be working better. 194 | 195 | =cut 196 | 197 | sub force_disconnect { 198 | my MogileFS::Client $self = shift; 199 | return $self->{backend}->force_disconnect(); 200 | } 201 | 202 | =head2 readonly 203 | 204 | $is_readonly = $mogc->readonly 205 | $mogc->readonly(1) 206 | 207 | Getter/setter to mark this client object as read-only. Purely a local 208 | operation/restriction, doesn't do a network operation to the mogilefsd 209 | server. 210 | 211 | =cut 212 | 213 | sub readonly { 214 | my MogileFS::Client $self = shift; 215 | return $self->{readonly} = $_[0] ? 1 : 0 if @_; 216 | return $self->{readonly}; 217 | } 218 | 219 | =head2 new_file 220 | 221 | $mogc->new_file($key) 222 | $mogc->new_file($key, $class) 223 | $mogc->new_file($key, $class, $content_length) 224 | $mogc->new_file($key, $class, $content_length , $opts_hashref) 225 | 226 | Start creating a new filehandle with the given key, and option given 227 | class and options. 228 | 229 | Returns a filehandle you should then print to, and later close to 230 | complete the operation. B check the return value from close! 231 | If your close didn't succeed, the file didn't get saved! 232 | 233 | $opts_hashref can contain keys: 234 | 235 | =over 236 | 237 | =item fid 238 | 239 | Explicitly specify the fid number to use, rather than it being automatically allocated. 240 | 241 | =item create_open_args 242 | 243 | Hashref of extra key/value pairs to send to mogilefsd in create_open phase. 244 | 245 | =item create_close_args 246 | 247 | Hashref of extra key/value pairs to send to mogilefsd in create_close phase. 248 | 249 | =item largefile 250 | 251 | Use MogileFS::ClientHTTPFile which will not load the entire file into memory 252 | like the default MogileFS::NewHTTPFile but requires that the storage node 253 | HTTP servers support the Content-Range header in PUT requests and is a little 254 | slower. 255 | 256 | =back 257 | 258 | =cut 259 | 260 | # returns MogileFS::NewHTTPFile object, or undef if no device 261 | # available for writing 262 | # ARGS: ( key, class, bytes?, opts? ) 263 | # where bytes is optional and the length of the file and opts is also optional 264 | # and is a hashref of options. supported options: fid = unique file id to use 265 | # instead of just picking one in the database. 266 | sub new_file { 267 | my MogileFS::Client $self = shift; 268 | return undef if $self->{readonly}; 269 | 270 | my ($key, $class, $bytes, $opts) = @_; 271 | $bytes += 0; 272 | $opts ||= {}; 273 | 274 | # Extra args to be passed along with the create_open and create_close commands. 275 | # Any internally generated args of the same name will overwrite supplied ones in 276 | # these hashes. 277 | my $create_open_args = $opts->{create_open_args} || {}; 278 | my $create_close_args = $opts->{create_close_args} || {}; 279 | 280 | $self->run_hook('new_file_start', $self, $key, $class, $opts); 281 | 282 | my $res = $self->{backend}->do_request 283 | ("create_open", { 284 | %$create_open_args, 285 | domain => $self->{domain}, 286 | class => $class, 287 | key => $key, 288 | fid => $opts->{fid} || 0, # fid should be specified, or pass 0 meaning to auto-generate one 289 | multi_dest => 1, 290 | }) or return undef; 291 | 292 | my $dests = []; # [ [devid,path], [devid,path], ... ] 293 | 294 | # determine old vs. new format to populate destinations 295 | unless (exists $res->{dev_count}) { 296 | push @$dests, [ $res->{devid}, $res->{path} ]; 297 | } else { 298 | for my $i (1..$res->{dev_count}) { 299 | push @$dests, [ $res->{"devid_$i"}, $res->{"path_$i"} ]; 300 | } 301 | } 302 | 303 | my $main_dest = shift @$dests; 304 | my ($main_devid, $main_path) = ($main_dest->[0], $main_dest->[1]); 305 | 306 | # create a MogileFS::NewHTTPFile object, based off of IO::File 307 | unless ($main_path =~ m!^http://!) { 308 | Carp::croak("This version of MogileFS::Client no longer supports non-http storage URLs.\n"); 309 | } 310 | 311 | $self->run_hook('new_file_end', $self, $key, $class, $opts); 312 | 313 | return IO::WrapTie::wraptie( ( $opts->{largefile} 314 | ? 'MogileFS::ClientHTTPFile' 315 | : 'MogileFS::NewHTTPFile' ), 316 | mg => $self, 317 | fid => $res->{fid}, 318 | path => $main_path, 319 | devid => $main_devid, 320 | backup_dests => $dests, 321 | class => $class, 322 | key => $key, 323 | content_length => $bytes+0, 324 | create_close_args => $create_close_args, 325 | overwrite => 1, 326 | ); 327 | } 328 | 329 | =head2 edit_file 330 | 331 | $mogc->edit_file($key, $opts_hashref) 332 | 333 | Edit the file with the the given key. 334 | 335 | 336 | B edit_file is currently EXPERIMENTAL and not recommended for 337 | production use. MogileFS is primarily designed for storing files 338 | for later retrieval, rather than editing. Use of this function may lead to 339 | poor performance and, until it has been proven mature, should be 340 | considered to also potentially cause data loss. 341 | 342 | B use of this function requires support for the DAV 'MOVE' 343 | verb and partial PUT (i.e. Content-Range in PUT) on the back-end 344 | storage servers (e.g. apache with mod_dav). 345 | 346 | Returns a seekable filehandle you can read/write to. Calling this 347 | function may invalidate some or all URLs you currently have for this 348 | key, so you should call ->get_paths again afterwards if you need 349 | them. 350 | 351 | On close of the filehandle, the new file contents will replace the 352 | previous contents (and again invalidate any existing URLs). 353 | 354 | By default, the file contents are preserved on open, but you may 355 | specify the overwrite option to zero the file first. The seek position 356 | is at the beginning of the file, but you may seek to the end to append. 357 | 358 | $opts_hashref can contain keys: 359 | 360 | =over 361 | 362 | =item overwrite 363 | 364 | The edit will overwrite the file, equivalent to opening with '>'. 365 | Default: false. 366 | 367 | =back 368 | 369 | =cut 370 | 371 | sub edit_file { 372 | my MogileFS::Client $self = shift; 373 | return undef if $self->{readonly}; 374 | 375 | my($key, $opts) = @_; 376 | 377 | my $res = $self->{backend}->do_request 378 | ("edit_file", { 379 | domain => $self->{domain}, 380 | key => $key, 381 | }) or return undef; 382 | 383 | my $moveReq = HTTP::Request->new('MOVE', $res->{oldpath}); 384 | $moveReq->header(Destination => $res->{newpath}); 385 | my $ua = LWP::UserAgent->new; 386 | my $resp = $ua->request($moveReq); 387 | unless ($resp->is_success) { 388 | warn "Failed to MOVE $res->{oldpath} to $res->{newpath}"; 389 | return undef; 390 | } 391 | 392 | return IO::WrapTie::wraptie('MogileFS::ClientHTTPFile', 393 | mg => $self, 394 | fid => $res->{fid}, 395 | path => $res->{newpath}, 396 | devid => $res->{devid}, 397 | class => $res->{class}, 398 | key => $key, 399 | overwrite => $opts->{overwrite}, 400 | ); 401 | } 402 | 403 | =head2 read_file 404 | 405 | $mogc->read_file($key) 406 | 407 | Read the file with the the given key. 408 | 409 | Returns a seekable filehandle you can read() from. Note that you cannot 410 | read line by line using <$fh> notation. 411 | 412 | Takes the same options as get_paths (which is called internally to get 413 | the URIs to read from). 414 | 415 | =cut 416 | 417 | sub read_file { 418 | my MogileFS::Client $self = shift; 419 | 420 | my @paths = $self->get_paths(@_); 421 | 422 | my $path = shift @paths; 423 | 424 | return if !$path; 425 | 426 | my @backup_dests = map { [ undef, $_ ] } @paths; 427 | 428 | return IO::WrapTie::wraptie('MogileFS::ClientHTTPFile', 429 | path => $path, 430 | backup_dests => \@backup_dests, 431 | readonly => 1, 432 | ); 433 | } 434 | 435 | =head2 store_file 436 | 437 | $mogc->store_file($key, $class, $fh_or_filename[, $opts_hashref]) 438 | 439 | Wrapper around new_file, print, and close. 440 | 441 | Given a key, class, and a filehandle or filename, stores the file 442 | contents in MogileFS. Returns the number of bytes stored on success, 443 | undef on failure. 444 | 445 | $opts_hashref can contain keys for new_file, and also the following: 446 | 447 | =over 448 | 449 | =item chunk_size 450 | 451 | Number of bytes to read and write and write at once out of the larger file. 452 | Defaults to 8192 bytes. Increasing this can increase performance at the cost 453 | of more memory used while uploading the file. 454 | Note that this mostly helps when using largefile => 1 455 | 456 | =back 457 | 458 | =cut 459 | 460 | sub store_file { 461 | my MogileFS::Client $self = shift; 462 | return undef if $self->{readonly}; 463 | 464 | my($key, $class, $file, $opts) = @_; 465 | $self->run_hook('store_file_start', $self, $key, $class, $opts); 466 | 467 | my $chunk_size = $opts->{chunk_size} || 8192; 468 | my $fh = $self->new_file($key, $class, undef, $opts) or return; 469 | my $fh_from; 470 | if (ref($file)) { 471 | $fh_from = $file; 472 | } else { 473 | open $fh_from, $file or return; 474 | } 475 | my $bytes; 476 | while (my $len = read $fh_from, my($chunk), $chunk_size) { 477 | $fh->print($chunk); 478 | $bytes += $len; 479 | } 480 | 481 | $self->run_hook('store_file_end', $self, $key, $class, $opts); 482 | 483 | close $fh_from unless ref $file; 484 | $fh->close or return; 485 | $bytes; 486 | } 487 | 488 | =head2 store_content 489 | 490 | $mogc->store_content($key, $class, $content[, $opts]); 491 | 492 | Wrapper around new_file, print, and close. Given a key, class, and 493 | file contents (scalar or scalarref), stores the file contents in 494 | MogileFS. Returns the number of bytes stored on success, undef on 495 | failure. 496 | 497 | =cut 498 | 499 | sub store_content { 500 | my MogileFS::Client $self = shift; 501 | return undef if $self->{readonly}; 502 | 503 | my($key, $class, $content, $opts) = @_; 504 | 505 | $self->run_hook('store_content_start', $self, $key, $class, $opts); 506 | 507 | my $fh = $self->new_file($key, $class, undef, $opts) or return; 508 | $content = ref($content) eq 'SCALAR' ? $$content : $content; 509 | $fh->print($content); 510 | 511 | $self->run_hook('store_content_end', $self, $key, $class, $opts); 512 | 513 | $fh->close or return; 514 | length($content); 515 | } 516 | 517 | =head2 get_paths 518 | 519 | @paths = $mogc->get_paths($key) 520 | @paths = $mogc->get_paths($key, $no_verify_bool); # old way 521 | @paths = $mogc->get_paths($key, { noverify => $bool }); # new way 522 | 523 | Given a key, returns an array of all the locations (HTTP URLs) that 524 | the file has been replicated to. 525 | 526 | =over 527 | 528 | =item noverify 529 | 530 | If the "no verify" option is set, the mogilefsd tracker doesn't verify 531 | that the first item returned in the list is up/alive. Skipping that 532 | check is faster, so use "noverify" if your application can do it 533 | faster/smarter. For instance, when giving L a list of URLs 534 | to reproxy to, Perlbal can intelligently find one that's alive, so use 535 | noverify and get out of mod_perl or whatever as soon as possible. 536 | 537 | =item zone 538 | 539 | If the zone option is set to 'alt', the mogilefsd tracker will use the 540 | alternative IP for each host if available, while constructing the paths. 541 | 542 | =item pathcount 543 | 544 | If the pathcount option is set to a positive integer greater than 2, the 545 | mogilefsd tracker will attempt to return that many different paths (if 546 | available) to the same file. If not present or out of range, this value 547 | defaults to 2. 548 | 549 | =back 550 | 551 | =cut 552 | 553 | # old style calling: 554 | # get_paths(key, noverify) 555 | # new style calling: 556 | # get_paths(key, { noverify => 0/1, zone => "alt", pathcount => 2..N }); 557 | # but with both, second parameter is optional 558 | # 559 | # returns list of URLs that key can be found at, or the empty 560 | # list on either error or no paths 561 | sub get_paths { 562 | my MogileFS::Client $self = shift; 563 | my ($key, $opts) = @_; 564 | 565 | # handle parameters, if any 566 | my ($noverify, $zone); 567 | unless (ref $opts) { 568 | $opts = { noverify => $opts }; 569 | } 570 | my %extra_args; 571 | 572 | $noverify = 1 if $opts->{noverify}; 573 | $zone = $opts->{zone}; 574 | 575 | if (my $pathcount = delete $opts->{pathcount}) { 576 | $extra_args{pathcount} = $pathcount; 577 | } 578 | 579 | $self->run_hook('get_paths_start', $self, $key, $opts); 580 | 581 | my $res = $self->{backend}->do_request 582 | ("get_paths", { 583 | domain => $self->{domain}, 584 | key => $key, 585 | noverify => $noverify ? 1 : 0, 586 | zone => $zone, 587 | %extra_args, 588 | }) or return (); 589 | 590 | my @paths = map { $res->{"path$_"} } (1..$res->{paths}); 591 | 592 | $self->run_hook('get_paths_end', $self, $key, $opts); 593 | 594 | return @paths; 595 | } 596 | 597 | =head2 get_file_data 598 | 599 | $dataref = $mogc->get_file_data($key) 600 | 601 | Wrapper around get_paths & LWP, which returns scalarref of file 602 | contents in a scalarref. 603 | 604 | Don't use for large data, as it all comes back to you in one string. 605 | 606 | =cut 607 | 608 | # given a key, returns a scalar reference pointing at a string containing 609 | # the contents of the file. takes one parameter; a scalar key to get the 610 | # data for the file. 611 | sub get_file_data { 612 | # given a key, load some paths and get data 613 | my MogileFS::Client $self = $_[0]; 614 | my ($key, $timeout) = ($_[1], $_[2]); 615 | 616 | my @paths = $self->get_paths($key, 1); 617 | return undef unless @paths; 618 | 619 | # iterate over each 620 | foreach my $path (@paths) { 621 | next unless defined $path; 622 | if ($path =~ m!^http://!) { 623 | # try via HTTP 624 | my $ua = new LWP::UserAgent; 625 | $ua->timeout($timeout || 10); 626 | 627 | my $res = $ua->get($path); 628 | if ($res->is_success) { 629 | my $contents = $res->content; 630 | return \$contents; 631 | } 632 | 633 | } else { 634 | # open the file from disk and just grab it all 635 | open FILE, "<$path" or next; 636 | my $contents; 637 | { local $/ = undef; $contents = ; } 638 | close FILE; 639 | return \$contents if $contents; 640 | } 641 | } 642 | return undef; 643 | } 644 | 645 | =head2 delete 646 | 647 | $mogc->delete($key); 648 | 649 | Delete a key from MogileFS. 650 | 651 | =cut 652 | 653 | # this method returns undef only on a fatal error such as inability to actually 654 | # delete a resource and inability to contact the server. attempting to delete 655 | # something that doesn't exist counts as success, as it doesn't exist. 656 | sub delete { 657 | my MogileFS::Client $self = shift; 658 | return undef if $self->{readonly}; 659 | 660 | my $key = shift; 661 | 662 | my $rv = $self->{backend}->do_request 663 | ("delete", { 664 | domain => $self->{domain}, 665 | key => $key, 666 | }); 667 | 668 | # if it's unknown_key, not an error 669 | return undef unless defined $rv || 670 | $self->{backend}->{lasterr} eq 'unknown_key'; 671 | 672 | return 1; 673 | } 674 | 675 | =head2 rename 676 | 677 | $mogc->rename($oldkey, $newkey); 678 | 679 | Rename file (key) in MogileFS from oldkey to newkey. Returns true on 680 | success, failure otherwise. 681 | 682 | =cut 683 | 684 | # this method renames a file. it returns an undef on error (only a fatal error 685 | # is considered as undef; "file didn't exist" isn't an error). 686 | sub rename { 687 | my MogileFS::Client $self = shift; 688 | return undef if $self->{readonly}; 689 | 690 | my ($fkey, $tkey) = @_; 691 | 692 | my $rv = $self->{backend}->do_request 693 | ("rename", { 694 | domain => $self->{domain}, 695 | from_key => $fkey, 696 | to_key => $tkey, 697 | }); 698 | 699 | # if it's unknown_key, not an error 700 | return undef unless defined $rv || 701 | $self->{backend}->{lasterr} eq 'unknown_key'; 702 | 703 | return 1; 704 | } 705 | 706 | =head2 file_debug 707 | 708 | my $info_gob = $mogc->file_debug(fid => $fid); 709 | ... or ... 710 | my $info_gob = $mogc->file_debug(key => $key); 711 | 712 | Thoroughly search for any database notes about a particular fid. Searchable by 713 | raw fidid, or by domain and key. B. Command hits the master 714 | database numerous times, and if you're using it in production something is 715 | likely very wrong. 716 | 717 | To be used with troubleshooting broken/odd files and errors from mogilefsd. 718 | 719 | =cut 720 | 721 | sub file_debug { 722 | my MogileFS::Client $self = shift; 723 | my %opts = @_; 724 | $opts{domain} = $self->{domain} unless exists $opts{domain}; 725 | 726 | my $res = $self->{backend}->do_request 727 | ("file_debug", { 728 | %opts, 729 | }) or return undef; 730 | return $res; 731 | } 732 | 733 | =head2 file_info 734 | 735 | my $fid = $mogc->file_info($key, { devices => 0 }); 736 | 737 | Used to return metadata about a file. Returns the domain, class, expected 738 | length, devcount, etc. Optionally device ids (not paths) can be returned as 739 | well. 740 | 741 | Should be used for informational purposes, and not usually for dynamically 742 | serving files. 743 | 744 | =cut 745 | 746 | sub file_info { 747 | my MogileFS::Client $self = shift; 748 | my ($key, $opts) = @_; 749 | 750 | my %extra = (); 751 | $extra{devices} = delete $opts->{devices}; 752 | die "Unknown arguments: " . join(', ', keys %$opts) if keys %$opts; 753 | 754 | my $res = $self->{backend}->do_request 755 | ("file_info", { 756 | domain => $self->{domain}, 757 | key => $key, 758 | %extra, 759 | }) or return undef; 760 | return $res; 761 | } 762 | 763 | =head2 list_keys 764 | 765 | $keys = $mogc->list_keys($prefix, $after[, $limit]); 766 | ($after, $keys) = $mogc->list_keys($prefix, $after[, $limit]); 767 | 768 | Used to get a list of keys matching a certain prefix. 769 | 770 | $prefix specifies what you want to get a list of. $after is the item 771 | specified as a return value from this function last time you called 772 | it. $limit is optional and defaults to 1000 keys returned. 773 | 774 | In list context, returns ($after, $keys). In scalar context, returns 775 | arrayref of keys. The value $after is to be used as $after when you 776 | call this function again. 777 | 778 | When there are no more keys in the list, you will get back undef or 779 | an empty list. 780 | 781 | =cut 782 | 783 | sub list_keys { 784 | my MogileFS::Client $self = shift; 785 | my ($prefix, $after, $limit) = @_; 786 | 787 | my $res = $self->{backend}->do_request 788 | ("list_keys", { 789 | domain => $self->{domain}, 790 | prefix => $prefix, 791 | after => $after, 792 | limit => $limit, 793 | }) or return undef; 794 | 795 | # construct our list of keys and the new after value 796 | my $resafter = $res->{next_after}; 797 | my $reslist = []; 798 | for (my $i = 1; $i <= $res->{key_count}+0; $i++) { 799 | push @$reslist, $res->{"key_$i"}; 800 | } 801 | return wantarray ? ($resafter, $reslist) : $reslist; 802 | } 803 | 804 | =head2 foreach_key 805 | 806 | $mogc->foreach_key( %OPTIONS, sub { my $key = shift; ... } ); 807 | $mogc->foreach_key( prefix => "foo:", sub { my $key = shift; ... } ); 808 | 809 | 810 | Functional interface/wrapper around list_keys. 811 | 812 | Given some %OPTIONS (currently only one, "prefix"), calls your callback 813 | for each key matching the provided prefix. 814 | 815 | =cut 816 | 817 | sub foreach_key { 818 | my MogileFS::Client $self = shift; 819 | my $callback = pop; 820 | Carp::croak("Last parameter not a subref") unless ref $callback eq "CODE"; 821 | my %opts = @_; 822 | my $prefix = delete $opts{prefix}; 823 | Carp::croak("Unknown option(s): " . join(", ", keys %opts)) if %opts; 824 | 825 | my $last = ""; 826 | my $max = 1000; 827 | my $count = $max; 828 | 829 | while ($count == $max) { 830 | my $res = $self->{backend}->do_request 831 | ("list_keys", { 832 | domain => $self->{domain}, 833 | prefix => $prefix, 834 | after => $last, 835 | limit => $max, 836 | }) or return undef; 837 | $count = $res->{key_count}+0; 838 | for (my $i = 1; $i <= $count; $i++) { 839 | $callback->($res->{"key_$i"}); 840 | } 841 | $last = $res->{"key_$count"}; 842 | } 843 | return 1; 844 | } 845 | 846 | # just makes some sleeping happen. first and only argument is number of 847 | # seconds to instruct backend thread to sleep for. 848 | sub sleep { 849 | my MogileFS::Client $self = shift; 850 | my $duration = shift; 851 | 852 | $self->{backend}->do_request("sleep", { duration => $duration + 0 }) 853 | or return undef; 854 | 855 | return 1; 856 | } 857 | 858 | =head2 update_class 859 | 860 | $mogc->update_class($key, $newclass); 861 | 862 | Update the replication class of a pre-existing file, causing 863 | the file to become more or less replicated. 864 | 865 | =cut 866 | 867 | sub update_class { 868 | my MogileFS::Client $self = shift; 869 | my ($key, $class) = @_; 870 | my $res = $self->{backend}->do_request 871 | ("updateclass", { 872 | domain => $self->{domain}, 873 | key => $key, 874 | class => $class, 875 | }) or return undef; 876 | return $res; 877 | } 878 | 879 | =head2 set_pref_ip 880 | 881 | $mogc->set_pref_ip({ "10.0.0.2" => "10.2.0.2" }); 882 | 883 | Weird option for old, weird network architecture. Sets a mapping 884 | table of preferred alternate IPs, if reachable. For instance, if 885 | trying to connect to 10.0.0.2 in the above example, the module would 886 | instead try to connect to 10.2.0.2 quickly first, then then fall back 887 | to 10.0.0.2 if 10.2.0.2 wasn't reachable. 888 | 889 | =cut 890 | 891 | # expects as argument a hashref of "standard-ip" => "preferred-ip" 892 | sub set_pref_ip { 893 | my MogileFS::Client $self = shift; 894 | $self->{backend}->set_pref_ip(shift) 895 | if $self->{backend}; 896 | } 897 | 898 | =head1 PLUGIN METHODS 899 | 900 | WRITEME 901 | 902 | =cut 903 | 904 | # used to support plugins that have modified the server, this builds things into 905 | # an argument list and passes them back to the server 906 | # TODO: there is no readonly protection here? does it matter? should we check 907 | # with the server to see what methods they support? (and if they should be disallowed 908 | # when the client is in readonly mode?) 909 | sub AUTOLOAD { 910 | # remove everything up to the last colon, so we only have the method name left 911 | my $method = $AUTOLOAD; 912 | $method =~ s/^.*://; 913 | 914 | return if $method eq 'DESTROY'; 915 | 916 | # let this work 917 | no strict 'refs'; 918 | 919 | # create a method to pass this on back 920 | *{$AUTOLOAD} = sub { 921 | my MogileFS::Client $self = shift; 922 | # pre-assemble the arguments into a hashref 923 | my $ct = 0; 924 | my $args = {}; 925 | $args->{"arg" . ++$ct} = shift() while @_; 926 | $args->{"argcount"} = $ct; 927 | 928 | # now put in standard args 929 | $args->{"domain"} = $self->{domain}; 930 | 931 | # now call and return whatever we get back from the backend 932 | return $self->{backend}->do_request("plugin_$method", $args); 933 | }; 934 | 935 | # now pass through 936 | goto &$AUTOLOAD; 937 | } 938 | 939 | =head1 HOOKS 940 | 941 | =head2 add_hook 942 | 943 | WRITEME 944 | 945 | =cut 946 | 947 | sub add_hook { 948 | my MogileFS::Client $self = shift; 949 | my $hookname = shift || return; 950 | 951 | if (@_) { 952 | $self->{hooks}->{$hookname} = shift; 953 | } else { 954 | delete $self->{hooks}->{$hookname}; 955 | } 956 | } 957 | 958 | sub run_hook { 959 | my MogileFS::Client $self = shift; 960 | my $hookname = shift || return; 961 | 962 | my $hook = $self->{hooks}->{$hookname}; 963 | return unless $hook; 964 | 965 | eval { $hook->(@_) }; 966 | 967 | warn "MogileFS::Client hook '$hookname' threw error: $@\n" if $@; 968 | } 969 | 970 | =head2 add_backend_hook 971 | 972 | WRITEME 973 | 974 | =cut 975 | 976 | sub add_backend_hook { 977 | my MogileFS::Client $self = shift; 978 | my $backend = $self->{backend}; 979 | 980 | $backend->add_hook(@_); 981 | } 982 | 983 | 984 | ################################################################################ 985 | # MogileFS class methods 986 | # 987 | 988 | sub _fail { 989 | croak "MogileFS: $_[0]"; 990 | } 991 | 992 | sub _debug { 993 | return 1 unless $MogileFS::DEBUG; 994 | 995 | my $msg = shift; 996 | my $ref = shift; 997 | chomp $msg; 998 | 999 | eval "use Data::Dumper;"; 1000 | print STDERR "$msg\n" . Dumper($ref) . "\n"; 1001 | return 1; 1002 | } 1003 | 1004 | 1005 | 1; 1006 | __END__ 1007 | 1008 | =head1 SEE ALSO 1009 | 1010 | L 1011 | 1012 | =head1 COPYRIGHT 1013 | 1014 | This module is Copyright 2003-2004 Brad Fitzpatrick, 1015 | and copyright 2005-2007 Six Apart, Ltd. 1016 | 1017 | All rights reserved. 1018 | 1019 | You may distribute under the terms of either the GNU General Public 1020 | License or the Artistic License, as specified in the Perl README file. 1021 | 1022 | =head1 WARRANTY 1023 | 1024 | This is free software. IT COMES WITHOUT WARRANTY OF ANY KIND. 1025 | 1026 | =head1 AUTHORS 1027 | 1028 | Brad Fitzpatrick 1029 | 1030 | Brad Whitaker 1031 | 1032 | Mark Smith 1033 | 1034 | -------------------------------------------------------------------------------- /lib/MogileFS/ClientHTTPFile.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::ClientHTTPFile; 2 | 3 | use strict; 4 | 5 | use LWP::UserAgent; 6 | use HTTP::Request; 7 | use HTTP::Status; 8 | use Errno qw(EIO EINVAL EPERM); 9 | 10 | use fields ('mg', 11 | 'fid', 12 | 'devid', 13 | 'class', 14 | 'key', 15 | 'path', 16 | 'length', 17 | 'pos', 18 | 'ua', 19 | 'eof', 20 | 'readonly', 21 | 'readLineChunkSize', 22 | ); 23 | 24 | 25 | sub TIEHANDLE { 26 | my MogileFS::ClientHTTPFile $self = shift; 27 | 28 | $self = fields::new($self) unless ref $self; 29 | 30 | my %args = @_; 31 | 32 | $self->{devid} = $args{devid}; 33 | $self->{path} = $args{path}; 34 | $self->{readLineChunkSize} = $args{readLineChunkSize} || 4096; 35 | 36 | $args{backup_dests} ||= []; 37 | 38 | my $ua = LWP::UserAgent->new( keep_alive => 60, timeout => 5 ); 39 | 40 | while ($self->{path}) { 41 | my $req; 42 | # overwrite needs changing to create if not exists? 43 | if ($args{overwrite}) { 44 | $req = HTTP::Request->new( PUT => $self->{path} ); # Ensure file overwritten/created, even if they don't print anything 45 | } else { 46 | $req = HTTP::Request->new( HEAD => $self->{path} ); 47 | } 48 | 49 | my $res = $ua->request( $req ); 50 | 51 | if ($res->is_success) { 52 | if ($args{overwrite}) { 53 | $self->{length} = 0; 54 | } else { 55 | $self->{length} = $res->header( 'Content-Length' ) || 0; 56 | } 57 | 58 | last; 59 | } else { 60 | my $dest = shift @{$args{backup_dests}}; 61 | 62 | if ($dest) { 63 | $self->{devid} = $dest->[0]; 64 | $self->{path} = $dest->[1]; 65 | } else { 66 | $self->{devid} = undef; 67 | $self->{path} = undef; 68 | } 69 | } 70 | } 71 | 72 | return unless $self->{path}; 73 | 74 | $self->{pos} = 0; 75 | $self->{ua} = $ua; 76 | $self->{eof} = 0; 77 | 78 | $self->{mg} = $args{mg}; 79 | $self->{fid} = $args{fid}; 80 | $self->{key} = $args{key}; 81 | $self->{readonly} = $args{readonly} || 0; 82 | 83 | return $self; 84 | } 85 | *new = *TIEHANDLE; 86 | 87 | sub READ { 88 | my MogileFS::ClientHTTPFile $self = shift; 89 | my $buf = \$_[0]; shift; 90 | my ($len, $offset) = @_; 91 | 92 | defined( $$buf ) or $$buf = ''; 93 | defined( $offset ) or $offset = 0; 94 | 95 | if ($len == 0) { 96 | $$buf = ''; 97 | return 0; 98 | } 99 | 100 | die "Negative len [$len] passed" if $len < 0; 101 | 102 | die "Negative offset [$offset] not supported" if $offset < 0; 103 | 104 | return 0 if ($self->EOF); 105 | 106 | my $start = $self->{pos}; 107 | my $end = $self->{pos} + $len - 1; 108 | 109 | my $req = HTTP::Request->new(GET => $self->{path}, [ 110 | Range => "bytes=$start-$end", 111 | ], ); 112 | 113 | my $res = $self->{ua}->request( $req ); 114 | 115 | if ($res->is_error) { 116 | if ($res->code eq RC_REQUEST_RANGE_NOT_SATISFIABLE) { 117 | $self->{eof} = 1; 118 | return 0; 119 | } 120 | 121 | $! = EIO; 122 | return; 123 | } 124 | 125 | my $length = length( $res->content ); 126 | 127 | $self->{pos} += $length; 128 | 129 | # Behaviour is not correct with offsets < length of existing buffer 130 | if ($offset) { 131 | $$buf = substr($$buf, 0, $offset) . $res->content; 132 | } else { 133 | $$buf = $res->content; 134 | } 135 | 136 | return $length; 137 | } 138 | *read = *READ; 139 | 140 | sub WRITE { 141 | my MogileFS::ClientHTTPFile $self = shift; 142 | 143 | my ($buf, $len, $offset) = @_; 144 | 145 | if ($self->{readonly}) { 146 | $! = EPERM; 147 | return; 148 | } 149 | 150 | if (defined $len || defined $offset) { 151 | $offset = 0 if ! defined $offset; 152 | 153 | $buf = substr($buf, $offset, $len); 154 | } 155 | 156 | $len = length($buf); 157 | 158 | my $start = $self->{pos}; 159 | my $end = $self->{pos} + $len - 1; 160 | 161 | my $req = HTTP::Request->new(PUT => $self->{path}, [ 162 | 'Content-Range' => "bytes $start-$end/*", 163 | ], ); 164 | 165 | $req->add_content($buf); 166 | 167 | my $res = $self->{ua}->request( $req ); 168 | 169 | if ($res->is_error) { 170 | $! = EIO; 171 | return; 172 | } 173 | 174 | if ($self->{pos} + $len > $self->{length}) { 175 | $self->{length} = $self->{pos} + $len; 176 | } 177 | 178 | $self->{pos} += $len; 179 | 180 | $self->{eof} = ($self->{pos} == $self->{length} ? 1 :0); 181 | 182 | return $len; 183 | } 184 | *write = *WRITE; 185 | 186 | sub EOF { 187 | my MogileFS::ClientHTTPFile $self = shift; 188 | 189 | return 1 if $self->{eof}; 190 | 191 | return unless $self->{length}; 192 | 193 | return $self->{pos} >= $self->{length}; 194 | } 195 | *eof = *EOF; 196 | 197 | sub TELL { 198 | my MogileFS::ClientHTTPFile $self = shift; 199 | 200 | return $self->{pos}; 201 | } 202 | *tell = *TELL; 203 | 204 | sub SEEK { 205 | my MogileFS::ClientHTTPFile $self = shift; 206 | 207 | my ($offset, $whence) = @_; 208 | 209 | if ($whence == 1) { 210 | $offset += $self->{pos}; 211 | } elsif ($whence == 2) { 212 | $offset += $self->{length}; 213 | } 214 | 215 | if ($offset > $self->{length}) { 216 | $! = EINVAL; 217 | return 0; 218 | } 219 | 220 | $self->{pos} = $offset; 221 | $self->{eof} = ($self->{pos} == $self->{length} ? 1 :0); 222 | 223 | return 1; 224 | } 225 | *seek = *SEEK; 226 | 227 | sub GETC { 228 | my MogileFS::ClientHTTPFile $self = shift; 229 | 230 | $self->READ( my $buf, 1 ); 231 | 232 | return $buf; 233 | } 234 | *getc = *GETC; 235 | 236 | sub PRINT { 237 | my MogileFS::ClientHTTPFile $self = shift; 238 | 239 | my $buf = join(defined $, ? $, : "", @_); 240 | 241 | $buf .= $\ if defined $\; 242 | 243 | $self->WRITE($buf, length($buf), 0); 244 | } 245 | *print = *PRINT; 246 | 247 | sub PRINTF { 248 | my MogileFS::ClientHTTPFile $self = shift; 249 | 250 | my $buf = sprintf(shift,@_); 251 | 252 | $self->WRITE($buf,length($buf),0); 253 | } 254 | *printf = *PRINTF; 255 | 256 | sub CLOSE { 257 | my MogileFS::ClientHTTPFile $self = shift; 258 | 259 | if ($self->{devid}) { 260 | my $mg = $self->{mg}; 261 | 262 | my $rv = $mg->{backend}->do_request 263 | ("create_close", { 264 | fid => $self->{fid}, 265 | devid => $self->{devid}, 266 | domain => $mg->{domain}, 267 | size => $self->{length}, 268 | key => $self->{key}, 269 | path => $self->{path}, 270 | }); 271 | 272 | unless ($rv) { 273 | $@ = "$mg->{backend}->{lasterr}: $mg->{backend}->{lasterrstr}"; 274 | return undef; 275 | } 276 | } 277 | 278 | return 1; 279 | } 280 | *close = *CLOSE; 281 | 282 | sub BINMODE { 283 | return 1; 284 | } 285 | *binmode = *BINMODE; 286 | 287 | sub FILENO { 288 | # Wanted by perl debugger 289 | return -1; 290 | } 291 | *fileno = *FILENO; 292 | 293 | # Must return undef (not just '') on EOF 294 | sub READLINE { 295 | my MogileFS::ClientHTTPFile $self = shift; 296 | 297 | my $retBuff; 298 | my $startPos = $self->{pos}; 299 | my $foundEol; 300 | READ: 301 | while (!$self->EOF) { 302 | my $readBuff; 303 | my $rc = $self->read($readBuff, $self->{readLineChunkSize}); 304 | # Undef $/ => we will only exit on EOF (which should be right) 305 | $foundEol = index($readBuff, $/) if defined $/; 306 | if (defined($foundEol) && $foundEol >= 0) { 307 | $foundEol += length($/); 308 | $retBuff ||= ''; 309 | $retBuff .= substr($readBuff, 0, $foundEol); 310 | # We have over-read, so go back 311 | $self->seek($startPos + length($retBuff) , 0); 312 | last READ; 313 | } 314 | else { 315 | # Go round again 316 | $retBuff .= $readBuff; 317 | } 318 | } 319 | return $retBuff; 320 | } 321 | *readline = *READLINE; 322 | 323 | sub path { 324 | my MogileFS::ClientHTTPFile $self = shift; 325 | 326 | return $self->{path}; 327 | } 328 | 329 | 1; 330 | -------------------------------------------------------------------------------- /lib/MogileFS/NewHTTPFile.pm: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | # MogileFS::HTTPFile object 3 | # NOTE: This is meant to be used within IO::WrapTie... 4 | # 5 | 6 | package MogileFS::NewHTTPFile; 7 | 8 | use strict; 9 | no strict 'refs'; 10 | 11 | use Carp; 12 | use POSIX qw( EAGAIN ); 13 | use Socket qw( PF_INET SOCK_STREAM ); 14 | use Errno qw( EINPROGRESS EISCONN ); 15 | 16 | use vars qw($PROTO_TCP); 17 | 18 | use fields ('host', 19 | 'sock', # IO::Socket; created only when we need it 20 | 'uri', 21 | 'data', # buffered data we have 22 | 'pos', # simulated file position 23 | 'length', # length of data field 24 | 'content_length', # declared length of data we will be receiving (not required) 25 | 'mg', 26 | 'fid', 27 | 'devid', 28 | 'class', 29 | 'key', 30 | 'path', # full URL to save data to 31 | 'backup_dests', 32 | 'bytes_out', # count of how many bytes we've written to the socket 33 | 'data_in', # storage for data we've read from the socket 34 | 'create_close_args', # Extra arguments hashref for the do_request of create_close during CLOSE 35 | ); 36 | 37 | sub path { _getset(shift, 'path'); } 38 | sub class { _getset(shift, 'class', @_); } 39 | sub key { _getset(shift, 'key', @_); } 40 | 41 | sub _parse_url { 42 | my MogileFS::NewHTTPFile $self = shift; 43 | my $url = shift; 44 | return 0 unless $url =~ m!http://(.+?)(/.+)$!; 45 | $self->{host} = $1; 46 | $self->{uri} = $2; 47 | $self->{path} = $url; 48 | return 1; 49 | } 50 | 51 | sub TIEHANDLE { 52 | my MogileFS::NewHTTPFile $self = shift; 53 | $self = fields::new($self) unless ref $self; 54 | 55 | my %args = @_; 56 | return undef unless $self->_parse_url($args{path}); 57 | 58 | $self->{data} = ''; 59 | $self->{length} = 0; 60 | $self->{backup_dests} = $args{backup_dests} || []; 61 | $self->{content_length} = $args{content_length} + 0; 62 | $self->{pos} = 0; 63 | $self->{$_} = $args{$_} foreach qw(mg fid devid class key); 64 | $self->{bytes_out} = 0; 65 | $self->{data_in} = ''; 66 | $self->{create_close_args} = $args{create_close_args} || {}; 67 | 68 | return $self; 69 | } 70 | *new = *TIEHANDLE; 71 | 72 | sub _sock_to_host { # (host) 73 | my MogileFS::NewHTTPFile $self = shift; 74 | my $host = shift; 75 | 76 | # setup 77 | my ($ip, $port) = $host =~ /^(.*):(\d+)$/; 78 | my $sock = "Sock_$host"; 79 | my $proto = $PROTO_TCP ||= getprotobyname('tcp'); 80 | my $sin; 81 | 82 | # create the socket 83 | socket($sock, PF_INET, SOCK_STREAM, $proto); 84 | $sin = Socket::sockaddr_in($port, Socket::inet_aton($ip)); 85 | 86 | # unblock the socket 87 | IO::Handle::blocking($sock, 0); 88 | 89 | # attempt a connection 90 | my $ret = connect($sock, $sin); 91 | if (!$ret && $! == EINPROGRESS) { 92 | my $win = ''; 93 | vec($win, fileno($sock), 1) = 1; 94 | 95 | # watch for writeability 96 | if (select(undef, $win, undef, 3) > 0) { 97 | $ret = connect($sock, $sin); 98 | 99 | # EISCONN means connected & won't re-connect, so success 100 | $ret = 1 if !$ret && $! == EISCONN; 101 | } 102 | } 103 | 104 | # just throw back the socket we have 105 | return $sock if $ret; 106 | return undef; 107 | } 108 | 109 | sub _connect_sock { 110 | my MogileFS::NewHTTPFile $self = shift; 111 | return 1 if $self->{sock}; 112 | 113 | my @down_hosts; 114 | 115 | while (!$self->{sock} && $self->{host}) { 116 | # attempt to connect 117 | return 1 if 118 | $self->{sock} = $self->_sock_to_host($self->{host}); 119 | 120 | push @down_hosts, $self->{host}; 121 | if (my $dest = shift @{$self->{backup_dests}}) { 122 | # dest is [$devid,$path] 123 | _debug("connecting to $self->{host} (dev $self->{devid}) failed; now trying $dest->[1] (dev $dest->[0])"); 124 | $self->_parse_url($dest->[1]) or _fail("bogus URL"); 125 | $self->{devid} = $dest->[0]; 126 | } else { 127 | $self->{host} = undef; 128 | } 129 | } 130 | 131 | _fail("unable to open socket to storage node (tried: @down_hosts): $!"); 132 | } 133 | 134 | # abstracted read; implements what ends up being a blocking read but 135 | # does it in terms of non-blocking operations. 136 | sub _getline { 137 | my MogileFS::NewHTTPFile $self = shift; 138 | my $timeout = shift || 3; 139 | return undef unless $self->{sock}; 140 | 141 | # short cut if we already have data read 142 | if ($self->{data_in} =~ s/^(.*?\r?\n)//) { 143 | return $1; 144 | } 145 | 146 | my $rin = ''; 147 | vec($rin, fileno($self->{sock}), 1) = 1; 148 | 149 | # nope, we have to read a line 150 | my $nfound; 151 | my $t1 = Time::HiRes::time(); 152 | while ($nfound = select($rin, undef, undef, $timeout)) { 153 | my $data; 154 | my $bytesin = sysread($self->{sock}, $data, 1024); 155 | if (defined $bytesin) { 156 | # we can also get 0 here, which means EOF. no error, but no data. 157 | $self->{data_in} .= $data if $bytesin; 158 | } else { 159 | next if $! == EAGAIN; 160 | _fail("error reading from node for device $self->{devid}: $!"); 161 | } 162 | 163 | # return a line if we got one 164 | if ($self->{data_in} =~ s/^(.*?\r?\n)//) { 165 | return $1; 166 | } 167 | 168 | # and if we got no data, it's time to return EOF 169 | unless ($bytesin) { 170 | $@ = "\$bytesin is 0"; 171 | return undef; 172 | } 173 | } 174 | 175 | # if we got here, nothing was readable in our time limit 176 | my $t2 = Time::HiRes::time(); 177 | $@ = sprintf("not readable in %0.02f seconds", $t2-$t1); 178 | return undef; 179 | } 180 | 181 | # abstracted write function that uses non-blocking I/O and checking for 182 | # writeability to ensure that we don't get stuck doing a write if the 183 | # node we're talking to goes down. also handles logic to fall back to 184 | # a backup node if we're on our first write and the first node is down. 185 | # this entire function is a blocking function, it just uses intelligent 186 | # non-blocking write functionality. 187 | # 188 | # this function returns success (1) or it croaks on failure. 189 | sub _write { 190 | my MogileFS::NewHTTPFile $self = shift; 191 | return undef unless $self->{sock}; 192 | 193 | my $win = ''; 194 | vec($win, fileno($self->{sock}), 1) = 1; 195 | 196 | # setup data and counters 197 | my $data = shift(); 198 | my $bytesleft = length($data); 199 | my $bytessent = 0; 200 | 201 | # main sending loop for data, will keep looping until all of the data 202 | # we've been asked to send is sent 203 | my $nfound; 204 | while ($bytesleft && ($nfound = select(undef, $win, undef, 3))) { 205 | my $bytesout = syswrite($self->{sock}, $data, $bytesleft, $bytessent); 206 | if (defined $bytesout) { 207 | # update our myriad counters 208 | $bytessent += $bytesout; 209 | $self->{bytes_out} += $bytesout; 210 | $bytesleft -= $bytesout; 211 | } else { 212 | # if we get EAGAIN, restart the select loop, else fail 213 | next if $! == EAGAIN; 214 | _fail("error writing to node for device $self->{devid}: $!"); 215 | } 216 | } 217 | return 1 unless $bytesleft; 218 | 219 | # at this point, we had a socket error, since we have bytes left, and 220 | # the loop above didn't finish sending them. if this was our first 221 | # write, let's try to fall back to a different host. 222 | unless ($self->{bytes_out}) { 223 | if (my $dest = shift @{$self->{backup_dests}}) { 224 | # dest is [$devid,$path] 225 | $self->_parse_url($dest->[1]) or _fail("bogus URL"); 226 | $self->{devid} = $dest->[0]; 227 | $self->_connect_sock; 228 | 229 | # now repass this write to try again 230 | return $self->_write($data); 231 | } 232 | } 233 | 234 | # total failure (croak) 235 | $self->{sock} = undef; 236 | _fail(sprintf("unable to write to any allocated storage node, last tried dev %s on host %s uri %s. Had sent %s bytes, %s bytes left", $self->{devid}, $self->{host}, $self->{uri}, $self->{bytes_out}, $bytesleft)); 237 | } 238 | 239 | sub PRINT { 240 | my MogileFS::NewHTTPFile $self = shift; 241 | 242 | # get data to send to server 243 | my $data = shift; 244 | my $newlen = length $data; 245 | $self->{pos} += $newlen; 246 | 247 | # now make socket if we don't have one 248 | if (!$self->{sock} && $self->{content_length}) { 249 | $self->_connect_sock; 250 | $self->_write("PUT $self->{uri} HTTP/1.0\r\nContent-length: $self->{content_length}\r\n\r\n"); 251 | } 252 | 253 | # write some data to our socket 254 | if ($self->{sock}) { 255 | # save the first 1024 bytes of data so that we can seek back to it 256 | # and do some work later 257 | if ($self->{length} < 1024) { 258 | if ($self->{length} + $newlen > 1024) { 259 | $self->{length} = 1024; 260 | $self->{data} .= substr($data, 0, 1024 - $self->{length}); 261 | } else { 262 | $self->{length} += $newlen; 263 | $self->{data} .= $data; 264 | } 265 | } 266 | 267 | # actually write 268 | $self->_write($data); 269 | } else { 270 | # or not, just stick it on our queued data 271 | $self->{data} .= $data; 272 | $self->{length} += $newlen; 273 | } 274 | } 275 | *print = *PRINT; 276 | 277 | sub CLOSE { 278 | my MogileFS::NewHTTPFile $self = shift; 279 | 280 | # if we're closed and we have no sock... 281 | unless ($self->{sock}) { 282 | $self->_connect_sock; 283 | $self->_write("PUT $self->{uri} HTTP/1.0\r\nContent-length: $self->{length}\r\n\r\n"); 284 | $self->_write($self->{data}); 285 | } 286 | 287 | # set a message in $! and $@ 288 | my $err = sub { 289 | $@ = "$_[0]\n"; 290 | return undef; 291 | }; 292 | 293 | # get response from put 294 | if ($self->{sock}) { 295 | my $line = $self->_getline(6); # wait up to 6 seconds for response to PUT. 296 | 297 | return $err->("Unable to read response line from server ($self->{sock}) after PUT of $self->{length} to $self->{uri}. _getline says: $@") 298 | unless defined $line; 299 | 300 | if ($line =~ m!^HTTP/\d+\.\d+\s+(\d+)!) { 301 | # all 2xx responses are success 302 | unless ($1 >= 200 && $1 <= 299) { 303 | my $errcode = $1; 304 | # read through to the body 305 | my ($found_header, $body); 306 | while (defined (my $l = $self->_getline)) { 307 | # remove trailing stuff 308 | $l =~ s/[\r\n\s]+$//g; 309 | $found_header = 1 unless $l; 310 | next unless $found_header; 311 | 312 | # add line to the body, with a space for readability 313 | $body .= " $l"; 314 | } 315 | $body = substr($body, 0, 512) if length $body > 512; 316 | return $err->("HTTP response $errcode from upload of $self->{uri} to $self->{sock}: $body"); 317 | } 318 | } else { 319 | return $err->("Response line not understood from $self->{sock}: $line"); 320 | } 321 | $self->{sock}->close; 322 | } 323 | 324 | my MogileFS $mg = $self->{mg}; 325 | my $domain = $mg->{domain}; 326 | 327 | my $fid = $self->{fid}; 328 | my $devid = $self->{devid}; 329 | my $path = $self->{path}; 330 | 331 | my $create_close_args = $self->{create_close_args}; 332 | 333 | my $key = shift || $self->{key}; 334 | 335 | my $rv = $mg->{backend}->do_request 336 | ("create_close", { 337 | %$create_close_args, 338 | fid => $fid, 339 | devid => $devid, 340 | domain => $domain, 341 | size => $self->{content_length} ? $self->{content_length} : $self->{length}, 342 | key => $key, 343 | path => $path, 344 | }); 345 | unless ($rv) { 346 | # set $@, as our callers expect $@ to contain the error message that 347 | # failed during a close. since we failed in the backend, we have to 348 | # do this manually. 349 | return $err->("$mg->{backend}->{lasterr}: $mg->{backend}->{lasterrstr}"); 350 | } 351 | 352 | return 1; 353 | } 354 | *close = *CLOSE; 355 | 356 | sub TELL { 357 | # return our current pos 358 | return $_[0]->{pos}; 359 | } 360 | *tell = *TELL; 361 | 362 | sub SEEK { 363 | # simply set pos... 364 | _fail("seek past end of file") if $_[1] > $_[0]->{length}; 365 | $_[0]->{pos} = $_[1]; 366 | } 367 | *seek = *SEEK; 368 | 369 | sub EOF { 370 | return ($_[0]->{pos} >= $_[0]->{length}) ? 1 : 0; 371 | } 372 | *eof = *EOF; 373 | 374 | sub BINMODE { 375 | # no-op, we're always in binary mode 376 | } 377 | *binmode = *BINMODE; 378 | 379 | sub READ { 380 | my MogileFS::NewHTTPFile $self = shift; 381 | my $count = $_[1] + 0; 382 | 383 | my $max = $self->{length} - $self->{pos}; 384 | $max = $count if $count < $max; 385 | 386 | $_[0] = substr($self->{data}, $self->{pos}, $max); 387 | $self->{pos} += $max; 388 | 389 | return $max; 390 | } 391 | *read = *READ; 392 | 393 | 394 | ################################################################################ 395 | # MogileFS::NewHTTPFile class methods 396 | # 397 | 398 | sub _fail { 399 | croak "MogileFS::NewHTTPFile: $_[0]"; 400 | } 401 | 402 | sub _debug { 403 | MogileFS::Client::_debug(@_); 404 | } 405 | 406 | sub _getset { 407 | my MogileFS::NewHTTPFile $self = shift; 408 | my $what = shift; 409 | 410 | if (@_) { 411 | # note: we're a TIEHANDLE interface, so we're not QUITE like a 412 | # normal class... our parameters tend to come in via an arrayref 413 | my $val = shift; 414 | $val = shift(@$val) if ref $val eq 'ARRAY'; 415 | return $self->{$what} = $val; 416 | } else { 417 | return $self->{$what}; 418 | } 419 | } 420 | 421 | sub _fid { 422 | my MogileFS::NewHTTPFile $self = shift; 423 | return $self->{fid}; 424 | } 425 | 426 | 1; 427 | -------------------------------------------------------------------------------- /t/00use.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use Test::More tests => 2; 5 | 6 | use_ok("MogileFS::Client"); 7 | use_ok("MogileFS::Admin"); 8 | 9 | 10 | -------------------------------------------------------------------------------- /t/10-basics.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use Test::More; 5 | use MogileFS::Client; 6 | use MogileFS::Admin; 7 | 8 | my $moga = MogileFS::Admin->new(hosts => ['127.0.0.1:7001']); 9 | my $doms = eval { $moga->get_domains }; 10 | 11 | unless ($doms) { 12 | plan skip_all => "No mogilefsd process running on 127.0.0.1:7001"; 13 | exit 0; 14 | } else { 15 | plan tests => 10; 16 | } 17 | 18 | my $test_ns = "_MogileFS::Client::TestSuite"; 19 | 20 | if ($doms->{$test_ns}) { 21 | pass("test namespace already exists"); 22 | } else { 23 | ok($moga->create_domain($test_ns), "created test namespace"); 24 | } 25 | 26 | my $mogc = MogileFS::Client->new(hosts => ['127.0.0.1:7001'], 27 | domain => $test_ns); 28 | ok($mogc, "made mogile client object"); 29 | 30 | # bogus class.. 31 | my $fh = $mogc->new_file("test_file1", "bogus_class"); 32 | ok(! $fh, "got a filehandle"); 33 | is($mogc->errcode, "unreg_class", "got correct error about making file in bogus class"); 34 | 35 | $fh = $mogc->new_file("test_file1"); 36 | ok($fh, "filehandle in general class"); 37 | 38 | my $data = "0123456789" x 500; 39 | my $wv = (print $fh $data); 40 | is($wv, length $data, "wrote data bytes out"); 41 | ok($fh->close, "closed successfully"); 42 | 43 | ok(scalar $mogc->get_paths("test_file1") >= 1, "exists in one or more places"); 44 | 45 | ok($mogc->delete("test_file1"), "deleted test file"); 46 | 47 | ok($moga->delete_domain($test_ns), "deleted test namespace"); 48 | 49 | #use Data::Dumper; 50 | #print Dumper($doms); 51 | 52 | 53 | 54 | 55 | -------------------------------------------------------------------------------- /t/20-edit.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | my $NUM_TESTS; 4 | BEGIN { 5 | $NUM_TESTS = 21; 6 | } 7 | 8 | use strict; 9 | use Test::More; 10 | use MogileFS::Client; 11 | use LWP; 12 | 13 | # Sorry, uncomment this if you intend to test/use the feature. 14 | plan skip_all => "experimental/unfinished feature, skipping tests"; 15 | exit 0; 16 | 17 | my $test_ns = "humyo"; 18 | my $data = "0123456789" x 10; 19 | my $data_len = length $data; 20 | 21 | my $mogc = MogileFS::Client->new(hosts => ['127.0.0.1:7001'], 22 | domain => $test_ns); 23 | 24 | my $key = 'edit_test_file'; 25 | 26 | my $fh; 27 | eval { $fh = $mogc->new_file($key, undef, undef, { largefile => 1 } ); }; 28 | 29 | if ($@ =~ m/couldn't connect/) { 30 | plan skip_all => "No mogilefsd process running on 127.0.0.1:7001"; 31 | exit 0; 32 | } else { 33 | plan tests => $NUM_TESTS; 34 | } 35 | 36 | ok($fh, "file handle using HTTPFile"); 37 | 38 | my $wv = (print $fh $data); 39 | is($wv, $data_len, "wrote data bytes out"); 40 | ok($fh->close, "closed successfully"); 41 | 42 | SKIP: { 43 | # Test that the back-end supports DAV MOVE and partial PUT 44 | my @urls = $mogc->get_paths($key); 45 | ok(scalar(@urls) > 0, "can get paths for key $key"); 46 | 47 | skip "No DAV MOVE support - edit_file won't work", ($NUM_TESTS - 4) 48 | unless server_supports_dav_move($urls[0]); 49 | 50 | skip "No partial PUT support - edit_file won't work", ($NUM_TESTS - 4) 51 | unless server_supports_partial_put($urls[0]); 52 | 53 | # Get on with the tests 54 | 55 | $fh = $mogc->read_file($key); 56 | 57 | ok($fh, "file handle from read_file"); 58 | 59 | my $buf; 60 | my $read = $fh->read($buf, $data_len); 61 | 62 | is($read, $data_len, "read $data_len bytes"); 63 | is($buf, $data, "got back data"); 64 | 65 | ok($fh->eof, "at EOF"); 66 | 67 | ok($fh->close, "closed successfully"); 68 | 69 | $fh = $mogc->edit_file($key); 70 | 71 | ok($fh, "file handle from edit_file"); 72 | 73 | ok($fh->seek(0, 2), "can seek to end"); 74 | ok($fh->binmode(), "can binmode file"); 75 | 76 | $wv = (print $fh $data); 77 | is($wv, $data_len, "wrote data bytes out"); 78 | ok($fh->close, "closed successfully"); 79 | 80 | $fh = $mogc->read_file($key); 81 | $read = $fh->read($buf, ($data_len * 2)); 82 | is($read, $data_len * 2, "read $data_len * 2 bytes"); 83 | is($buf, $data . $data, "got back data"); 84 | $fh->close; 85 | 86 | $fh = $mogc->edit_file($key, { overwrite => 1 }); 87 | 88 | ok($fh, "file handle from edit_file with overwrite"); 89 | 90 | $wv = (print $fh $data); 91 | is($wv, $data_len, "wrote data bytes out"); 92 | ok($fh->close, "closed successfully"); 93 | 94 | $fh = $mogc->read_file($key); 95 | $read = $fh->read($buf, $data_len); 96 | is($read, $data_len, "read $data_len bytes"); 97 | is($buf, $data, "got back data"); 98 | $fh->close; 99 | } 100 | 101 | sub server_supports_dav_move { 102 | my $moveFrom = shift; 103 | 104 | my $moveTo = $moveFrom . ".movetest"; 105 | 106 | # Move the test url 107 | my $req = HTTP::Request->new(MOVE => $moveFrom); 108 | $req->header(Destination => $moveTo); 109 | my $ua = LWP::UserAgent->new; 110 | my $resp = $ua->request($req); 111 | return unless $resp->is_success; 112 | 113 | # Put it back 114 | $req = HTTP::Request->new(MOVE => $moveTo); 115 | $req->header(Destination => $moveFrom); 116 | $resp = $ua->request($req); 117 | return unless $resp->is_success; 118 | 119 | return 1; 120 | } 121 | 122 | sub server_supports_partial_put { 123 | my $url = shift; 124 | 125 | my $testUrl = $url . ".puttest"; 126 | 127 | my $totalLength = 100; 128 | my $startData = "0" x $totalLength; 129 | 130 | # Create a file 131 | my $req = HTTP::Request->new(PUT => $testUrl); 132 | $req->add_content($startData); 133 | my $ua = LWP::UserAgent->new; 134 | my $resp = $ua->request($req); 135 | return unless $resp->is_success; 136 | 137 | # Overwrite the first half 138 | $req = HTTP::Request->new(PUT => $testUrl); 139 | my $partialPutEnd = $totalLength / 2; 140 | $req->header('Content-Range' => "bytes 0-$partialPutEnd/*"); 141 | $req->add_content("1" x ($partialPutEnd + 1)); # range is inclusive of end offset 142 | $resp = $ua->request($req); 143 | return unless $resp->is_success; 144 | 145 | # Fetch the whole thing 146 | $resp = $ua->get($testUrl); 147 | my $fetchedData = $resp->content; 148 | my $expectedData = "1" x ($partialPutEnd + 1) . "0" x ($totalLength - ($partialPutEnd + 1)); 149 | return unless $fetchedData eq $expectedData; 150 | 151 | return 1; 152 | } 153 | -------------------------------------------------------------------------------- /t/30-disconnect.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use Test::More; 5 | use MogileFS::Client; 6 | 7 | my $obj = bless({ 8 | backend => bless({ 9 | }, 'MogileFS::Backend') 10 | }, 'MogileFS::Client'); 11 | 12 | isa_ok($obj, 'MogileFS::Client'); 13 | 14 | $obj->{backend}->{sock_cache} = 'x'; 15 | is($obj->{backend}->{sock_cache}, 'x'); 16 | 17 | $obj->force_disconnect(); 18 | is($obj->{backend}->{sock_cache}, undef); 19 | 20 | done_testing(); 21 | --------------------------------------------------------------------------------