├── debian ├── compat ├── mogilefsd.examples ├── mogstored.examples ├── watch ├── po │ ├── POTFILES.in │ └── templates.pot ├── mogstored.install ├── mogilefsd.templates ├── mogilefsd.install ├── mogilefsd.postrm ├── changelog ├── mogstored.postrm ├── mogilefsd.config ├── mogstored.templates ├── mogstored.config ├── mogstored.preinst ├── mogilefsd.preinst ├── mogilefsd.postinst ├── copyright ├── mogstored.postinst ├── control ├── rules ├── mogilefsd.init └── mogstored.init ├── dev-killmogstored.sh ├── conf ├── mogstored.conf └── mogilefsd.conf ├── lib ├── MogileFS │ ├── Overview.pm │ ├── Sys.pm │ ├── Exception.pm │ ├── Connection │ │ ├── Mogstored.pm │ │ ├── Worker.pm │ │ └── Client.pm │ ├── ReplicationPolicy │ │ └── Union.pm │ ├── DeviceState.pm │ ├── ReplicationPolicy.pm │ ├── Worker │ │ └── Reaper.pm │ ├── ReplicationRequest.pm │ ├── Domain.pm │ ├── DevFID.pm │ └── IOStatWatcher.pm ├── Mogstored │ ├── HTTPServer │ │ ├── None.pm │ │ ├── Lighttpd.pm │ │ ├── Apache.pm │ │ └── Perlbal.pm │ ├── ChildProcess.pm │ ├── SideChannelListener.pm │ ├── HTTPServer.pm │ ├── SideChannelClient.pm │ ├── FIDStatter.pm │ └── ChildProcess │ │ ├── DiskUsage.pm │ │ └── IOStat.pm └── mogdeps │ └── Perlbal │ ├── CommandContext.pm │ ├── Util.pm │ ├── Plugin │ ├── AutoRemoveLeadingDir.pm │ ├── AtomInject.pm │ ├── Queues.pm │ ├── NotModified.pm │ ├── MaxContentLength.pm │ ├── Include.pm │ ├── Vpaths.pm │ ├── LazyCDN.pm │ ├── Redirect.pm │ ├── AtomStream.pm │ ├── Highpri.pm │ ├── EchoService.pm │ └── Stats.pm │ ├── ChunkedUploadState.pm │ ├── ManageCommand.pm │ ├── UploadListener.pm │ ├── SocketSSL.pm │ ├── ClientManage.pm │ └── Test │ └── WebClient.pm ├── .shipit ├── MANIFEST.SKIP ├── t ├── util.t ├── hosts-devices.t ├── replpolicy-parsing.t ├── store.t ├── domains-classes.t ├── mogstored-shutdown.t ├── 10-weighting.t ├── fid-stat.t ├── multiple-hosts-replpol.t └── 20-filepaths.t ├── doc ├── apache.conf ├── lighttpd.conf ├── pluggable-replication-policies.txt ├── build-debian-package.txt ├── testing.txt ├── memcache-support.txt └── fsck-notes.txt ├── dev-mogstored.pl ├── TESTING ├── makedocs.pl ├── Makefile.PL ├── mogilefsd ├── MogileFS-Server.spec ├── MANIFEST ├── mogautomount ├── TODO └── mogdbsetup /debian/compat: -------------------------------------------------------------------------------- 1 | 4 2 | -------------------------------------------------------------------------------- /debian/mogilefsd.examples: -------------------------------------------------------------------------------- 1 | conf/mogilefsd.conf 2 | -------------------------------------------------------------------------------- /debian/mogstored.examples: -------------------------------------------------------------------------------- 1 | conf/mogstored.conf 2 | -------------------------------------------------------------------------------- /debian/watch: -------------------------------------------------------------------------------- 1 | version=2 2 | http://www.danga.com/dist/MogileFS/server/mogilefs-server-([0-9].*)\.tar.gz 3 | -------------------------------------------------------------------------------- /dev-killmogstored.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ps afx | grep mogstore | perl -npe 's/\spts.+//' | xargs kill 4 | -------------------------------------------------------------------------------- /debian/po/POTFILES.in: -------------------------------------------------------------------------------- 1 | [type: gettext/rfc822deb] mogstored.templates 2 | [type: gettext/rfc822deb] mogilefsd.templates 3 | -------------------------------------------------------------------------------- /conf/mogstored.conf: -------------------------------------------------------------------------------- 1 | maxconns = 10000 2 | httplisten = 0.0.0.0:7500 3 | mgmtlisten = 0.0.0.0:7501 4 | docroot = /var/mogdata 5 | -------------------------------------------------------------------------------- /lib/MogileFS/Overview.pm: -------------------------------------------------------------------------------- 1 | =head1 MogileFS Overview 2 | 3 | Following is a high-level overview of MogileFS. 4 | 5 | =cut 6 | 7 | -------------------------------------------------------------------------------- /.shipit: -------------------------------------------------------------------------------- 1 | steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN 2 | 3 | svn.tagpattern = mogilefs-server-%v 4 | 5 | -------------------------------------------------------------------------------- /debian/mogstored.install: -------------------------------------------------------------------------------- 1 | usr/bin/mogautomount /usr/bin 2 | usr/bin/mogstored /usr/bin 3 | usr/share/man/man1/mogautomount.1p /usr/share/man/man1 4 | usr/share/man/man1/mogstored.1p /usr/share/man/man1 5 | usr/share/perl5/Mogstored /usr/share/perl5 6 | -------------------------------------------------------------------------------- /lib/Mogstored/HTTPServer/None.pm: -------------------------------------------------------------------------------- 1 | package Mogstored::HTTPServer::None; 2 | use strict; 3 | use base 'Mogstored::HTTPServer'; 4 | 5 | # Allow the use of an existing backend DAV server not managed by mogstored 6 | 7 | sub start { 8 | my $self = shift; 9 | return 1; 10 | } 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /debian/mogilefsd.templates: -------------------------------------------------------------------------------- 1 | Template: mogilefsd/runasuser 2 | Type: string 3 | _Default: mogilefsd 4 | _Description: User to run mogilefsd as: 5 | The mogilefsd storage engine cannot be run as root. What user should it be 6 | run as? This user will be created for you as a system user if it does not 7 | yet exist. 8 | -------------------------------------------------------------------------------- /lib/MogileFS/Sys.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::Sys; 2 | use strict; 3 | use Socket qw(MSG_NOSIGNAL); 4 | use vars qw($FLAG_NOSIGNAL); 5 | 6 | # used in send() calls to request not to get SIGPIPEd 7 | eval { $FLAG_NOSIGNAL = MSG_NOSIGNAL }; 8 | 9 | sub flag_nosignal { 10 | return $FLAG_NOSIGNAL; 11 | } 12 | 13 | 1; 14 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | .shipit 2 | makedocs.pl 3 | dev-mogstored.pl 4 | \bCVS\b 5 | ^MANIFEST\. 6 | ^Makefile$ 7 | ~$ 8 | \.html$ 9 | \.old$ 10 | ^blib/ 11 | _blib$ 12 | ^MakeMaker-\d 13 | ^\.exists 14 | \bdebian\b 15 | \bconf\b 16 | \.svn 17 | dev-killmogstored.sh 18 | make-par.sh 19 | mogstored.pp 20 | pp.log 21 | trace 22 | MogileFS-Server.spec 23 | -------------------------------------------------------------------------------- /debian/mogilefsd.install: -------------------------------------------------------------------------------- 1 | usr/bin/mogdbsetup /usr/bin 2 | usr/bin/mogilefsd /usr/bin 3 | usr/share/man/man1/mogilefsd.1p /usr/share/man/man1 4 | usr/share/man/man3/MogileFS* /usr/share/man/man3 5 | usr/share/perl5/MogileFS /usr/share/perl5 6 | usr/share/perl5/dev-mogstored.pl /usr/share/mogilefsd 7 | usr/share/perl5/makedocs.pl /usr/share/mogilefsd 8 | -------------------------------------------------------------------------------- /lib/MogileFS/Exception.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::Exception; 2 | use strict; 3 | use warnings; 4 | 5 | sub new { 6 | my ($class, $errcode) = @_; 7 | return bless { 8 | code => $errcode, 9 | }, $class; 10 | } 11 | 12 | sub throw { 13 | my $self = shift; 14 | die $self; 15 | } 16 | 17 | sub code { $_[0]{code} } 18 | 19 | 1; 20 | -------------------------------------------------------------------------------- /debian/mogilefsd.postrm: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | #DEBHELPER# 4 | 5 | if [ "$1" = "purge" ] 6 | then 7 | rm -f /etc/mogilefs/mogilefsd.conf 8 | rm -f /etc/default/mogilefsd 9 | 10 | [ -d /etc/mogilefs ] && rmdir --ignore-fail-on-non-empty /etc/mogilefs 11 | rmdir --ignore-fail-on-non-empty /etc/default 12 | fi 13 | 14 | rm -f /var/run/mogilefsd.pid 15 | 16 | -------------------------------------------------------------------------------- /t/util.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use MogileFS::Util qw(weighted_list); 7 | 8 | plan tests => 1; 9 | 10 | my %first; 11 | for (1..100) { 12 | my @l = weighted_list(["A", 0.1], ["B", 0.3]); 13 | $first{$l[0]}++; 14 | } 15 | 16 | # conservative when playing with randomness 17 | ok($first{"B"} >= ($first{"A"} * 1.8), "weightest list"); 18 | 19 | 20 | -------------------------------------------------------------------------------- /debian/changelog: -------------------------------------------------------------------------------- 1 | mogilefs-server (1.00-2) unstable; urgency=low 2 | 3 | * fix data loss bug when the 'tempfile' table is InnoDB and the 4 | server is restarted while the tempfile table is empty. 5 | 6 | -- Pavel Skaldin Thu, 2 Mar 2006 17:12:51 -0800 7 | 8 | mogilefs-server (1.00-1) unstable; urgency=low 9 | 10 | * Initial release 11 | 12 | -- Jay Bonci Fri, 14 Jan 2005 15:41:28 -0500 13 | -------------------------------------------------------------------------------- /doc/apache.conf: -------------------------------------------------------------------------------- 1 | ServerType standalone 2 | 3 | #ServerRoot "/etc/apache-perl" 4 | #PidFile /var/run/apache-perl.pid 5 | #ScoreBoardFile /var/run/apache-perl.scoreboard 6 | 7 | Timeout 30 8 | KeepAlive Off 9 | 10 | Port 7500 11 | ErrorLog /dev/null 12 | 13 | PidFile apache.pid 14 | LoadModule dav_module /usr/lib/apache/1.3/libdav.so 15 | 16 | DavLockDB DavLock 17 | DocumentRoot /var/mogdata 18 | 19 | Dav On 20 | 21 | 22 | -------------------------------------------------------------------------------- /debian/mogstored.postrm: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | 4 | PKG=mogstored 5 | 6 | . /usr/share/debconf/confmodule || exit 0 7 | 8 | if [ "$1" = "purge" ] 9 | then 10 | rm -f /etc/mogilefs/mogstored.conf 11 | rmdir --ignore-fail-on-non-empty /etc/mogilefs 12 | 13 | db_get $PKG/docroot 14 | DOCROOT=$RET 15 | 16 | rmdir --ignore-fail-on-non-empty $DOCROOT &> /dev/null 17 | 18 | fi 19 | 20 | #DEBHELPER# 21 | 22 | rm -f /var/run/mogstored.pid 23 | 24 | 25 | -------------------------------------------------------------------------------- /debian/mogilefsd.config: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | PACKAGE=mogilefsd 4 | 5 | set -e 6 | . /usr/share/debconf/confmodule 7 | 8 | RUNASUSER="" 9 | 10 | while [ "$RUNASUSER" = "" ] 11 | do 12 | 13 | db_input medium $PACKAGE/runasuser || true 14 | db_go 15 | 16 | db_get $PACKAGE/runasuser 17 | RUNASUSER="$RET" 18 | 19 | if [ "$RUNASUSER" = "root" ] 20 | then 21 | 22 | db_reset $PACKAGE/runasuser 23 | db_fset $PACKAGE/runasuser seen false 24 | fi 25 | 26 | done 27 | -------------------------------------------------------------------------------- /dev-mogstored.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use Cwd; 4 | my $cwd = getcwd; 5 | my ($svn) = $cwd =~ m!^(.+)/mogilefs/server! or 6 | die "not sure where we're at"; 7 | 8 | $ENV{PERL5LIB} = join(":", 9 | "$svn/mogilefs/server/lib", 10 | "$svn/perlbal/lib", 11 | ($ENV{PERL5LIB} ? ($ENV{PERL5LIB}) : ()), 12 | ); 13 | print "export PERL5LIB=$ENV{PERL5LIB}\n"; 14 | system($^X, "./mogstored", @ARGV); 15 | -------------------------------------------------------------------------------- /debian/mogstored.templates: -------------------------------------------------------------------------------- 1 | Template: mogstored/docroot 2 | Type: string 3 | _Default: /var/mogdata 4 | _Description: Document root for mogstored: 5 | The mogstored daemon needs a directory for the root of its filetree. 6 | 7 | Template: mogstored/runasuser 8 | Type: string 9 | _Default: mogstored 10 | _Description: User to run mogstored as: 11 | The mogstored storage daemon cannot be run as root. What user should it be 12 | run as? This user will be created for you as a system user if it does not 13 | yet exist. 14 | -------------------------------------------------------------------------------- /debian/mogstored.config: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | PACKAGE=mogstored 4 | 5 | set -e 6 | . /usr/share/debconf/confmodule 7 | 8 | db_input medium $PACKAGE/docroot || true 9 | db_go 10 | 11 | RUNASUSER="" 12 | 13 | while [ "$RUNASUSER" = "" ] 14 | do 15 | 16 | db_input medium $PACKAGE/runasuser || true 17 | db_go 18 | 19 | db_get $PACKAGE/runasuser 20 | RUNASUSER="$RET" 21 | 22 | if [ "$RUNASUSER" = "root" ] 23 | then 24 | 25 | db_reset $PACKAGE/runasuser 26 | db_fset $PACKAGE/runasuser seen false 27 | fi 28 | 29 | done 30 | -------------------------------------------------------------------------------- /debian/mogstored.preinst: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | PKG=mogstored 4 | DEFAULTFILE=/etc/default/$PKG 5 | 6 | . /usr/share/debconf/confmodule || exit 0 7 | 8 | #DEBHELPER# 9 | 10 | set -e 11 | 12 | db_get $PKG/runasuser 13 | RUNAS=$RET 14 | 15 | getent passwd $RUNAS >/dev/null || adduser --system $RUNAS 16 | 17 | if [ ! -e $DEFAULTFILE ] 18 | then 19 | mkdir -p /etc/default 20 | echo "#!/bin/sh" >> $DEFAULTFILE 21 | echo "# Defaults for the mogstored package" >> $DEFAULTFILE 22 | echo "MOGSTORED_RUNASUSER=$RUNAS" >> $DEFAULTFILE 23 | fi 24 | -------------------------------------------------------------------------------- /debian/mogilefsd.preinst: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | PKG=mogilefsd 4 | DEFAULTFILE=/etc/default/$PKG 5 | 6 | . /usr/share/debconf/confmodule || exit 0 7 | 8 | #DEBHELPER# 9 | 10 | set -e 11 | 12 | db_get $PKG/runasuser 13 | RUNAS=$RET 14 | 15 | getent passwd $RUNAS >/dev/null || adduser --system $RUNAS 16 | 17 | if [ ! -e $DEFAULTFILE ] 18 | then 19 | mkdir -p /etc/default 20 | echo "#!/bin/sh" >> $DEFAULTFILE 21 | echo "# Defaults for the mogilefsd package" >> $DEFAULTFILE 22 | echo "MOGILEFSD_RUNASUSER=$RUNAS" >> $DEFAULTFILE 23 | fi 24 | 25 | -------------------------------------------------------------------------------- /debian/mogilefsd.postinst: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | PKG=mogilefsd 4 | DEFAULTFILE=/etc/default/$PKG 5 | 6 | . /usr/share/debconf/confmodule || exit 0 7 | 8 | #DEBHELPER# 9 | 10 | set -e 11 | 12 | case "$1" in 13 | configure) 14 | 15 | if [ ! -e /etc/mogilefs/mogilefsd.conf ] 16 | then 17 | mkdir -p /etc/mogilefs 18 | cp /usr/share/doc/mogilefsd/examples/mogilefsd.conf /etc/mogilefs/mogilefsd.conf 19 | fi 20 | 21 | ;; 22 | 23 | abort-upgrade|abort-remove|abort-deconfigure) 24 | 25 | ;; 26 | 27 | *) 28 | echo "postinst called with unknown argument \`$1'" >&2 29 | exit 1 30 | ;; 31 | esac 32 | db_stop 33 | 34 | -------------------------------------------------------------------------------- /doc/lighttpd.conf: -------------------------------------------------------------------------------- 1 | # You can use lighttpd instead of mogstored on your storage nodes by using 2 | # this config: 3 | 4 | server.document-root = "/var/mogdata/" 5 | server.port = 7500 6 | server.modules = ( "mod_webdav" ) 7 | webdav.activate = "enable" 8 | 9 | # that alone works, but you can add more options as you see fit. 10 | # 11 | # Note that you'll need to find a way to write out your 'usage' files 12 | # on each /var/mogdata/dev/usage separately, as mogilefsd monitors 13 | # those for disk usage. A separate tool for this is planned, but 14 | # doesn't yet exist. (for instance, running mogstored in 15 | # write-out-usage-file-only mode) 16 | -------------------------------------------------------------------------------- /TESTING: -------------------------------------------------------------------------------- 1 | Testing under MySQL: 2 | -------------------- 3 | We use the default 'test' user whom is allowed to connect to the 'test' database from localhost only. 4 | # make test \ 5 | MOGTEST_DBUSER=test \ 6 | MOGTEST_DBNAME=test \ 7 | MOGTEST_DBTYPE=MySQL 8 | 9 | Testing under Postgresql: 10 | ------------------------- 11 | Database setup: 12 | # createuser -SRlD mogile 13 | # createdb -E UTF8 -O mogile tmp_mogiletest 14 | 15 | To run the tests: 16 | # make test \ 17 | MOGTEST_DBUSER=mogile \ 18 | MOGTEST_DBNAME=tmp_mogiletest \ 19 | MOGTEST_DBTYPE=Postgres 20 | 21 | Testing under SQLite: 22 | --------------------- 23 | # make test \ 24 | MOGTEST_DBUSER=mogile \ 25 | MOGTEST_DBNAME=tmp_mogiletest \ 26 | MOGTEST_DBTYPE=SQLite 27 | -------------------------------------------------------------------------------- /debian/copyright: -------------------------------------------------------------------------------- 1 | This package was debianized by Jay Bonci on 2 | Fri Jan 14 15:57:37 EST 2005 3 | 4 | It was downloaded from: http://www.danga.com/dist/MogileFS/server/ 5 | 6 | Upstream Author: 7 | Brad Fitzpatrick 8 | Brad Whitaker 9 | Mark Smith 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 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/CommandContext.pm: -------------------------------------------------------------------------------- 1 | # keep track of the surrounding context for a ManageCommand, so commands 2 | # can be less verbose when in config files 3 | # 4 | # Copyright 2005-2007, Six Apart, Ltd. 5 | # 6 | 7 | package Perlbal::CommandContext; 8 | use strict; 9 | use warnings; 10 | no warnings qw(deprecated); 11 | 12 | use fields ( 13 | 'last_created', # the name of the last pool or service created 14 | 'verbose', # scalar bool: verbosity ("OK" on success) 15 | ); 16 | 17 | sub new { 18 | my $class = shift; 19 | my $self = fields::new($class); 20 | return $self; 21 | } 22 | 23 | sub verbose { 24 | my $self = shift; 25 | $self->{verbose} = shift if @_; 26 | $self->{verbose}; 27 | } 28 | 29 | 1; 30 | 31 | # Local Variables: 32 | # mode: perl 33 | # c-basic-indent: 4 34 | # indent-tabs-mode: nil 35 | # End: 36 | -------------------------------------------------------------------------------- /lib/Mogstored/ChildProcess.pm: -------------------------------------------------------------------------------- 1 | package Mogstored::ChildProcess; 2 | use strict; 3 | 4 | sub run { 5 | my $class = shift; 6 | die "run not implemented for $class\n"; 7 | } 8 | 9 | sub pre_exec_init { 10 | my $class = shift; 11 | # override to setup environment ... 12 | } 13 | 14 | sub exec { 15 | my $class = shift; 16 | if (_running_under_par()) { 17 | # then we can't exec, as we'll lose magic @INC 18 | # ghetto: 19 | #for (3..100) { POSIX::close($_); } 20 | my $rv = eval "use $class; 1" or die "Failed to load $class: $@\n"; 21 | $class->run; 22 | } else { 23 | exec $^X, "-M$class", "-e", "$class->run;"; 24 | } 25 | die "$class run loop ended!\n"; 26 | } 27 | 28 | sub _running_under_par { 29 | # not the best test in the world, but works. 30 | return (grep { ref $_ eq "CODE" } @INC) ? 1 : 0; 31 | } 32 | 33 | 1; 34 | -------------------------------------------------------------------------------- /lib/Mogstored/SideChannelListener.pm: -------------------------------------------------------------------------------- 1 | package Mogstored::SideChannelListener; 2 | use strict; 3 | use base 'Perlbal::TCPListener'; 4 | use Mogstored::SideChannelClient; 5 | 6 | sub new { 7 | my ($class, $hostport) = @_; 8 | # we don't _really_ need this, but TCPListener kinda does, to keep it from 9 | # exploding/warning. so we created this stub service above in our static 10 | # config, just for this. 11 | my $svc = Perlbal->service("mgmt") or die "Where is mgmt service?"; 12 | return $class->SUPER::new($hostport, $svc); 13 | } 14 | 15 | sub event_read { 16 | my $self = shift; 17 | # accept as many connections as we can 18 | while (my ($csock, $peeraddr) = $self->{sock}->accept) { 19 | IO::Handle::blocking($csock, 0); 20 | my $client = Mogstored::SideChannelClient->new($csock); 21 | $client->watch_read(1); 22 | } 23 | } 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/MogileFS/Connection/Mogstored.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::Connection::Mogstored; 2 | use strict; 3 | use IO::Socket::INET; 4 | 5 | sub new { 6 | my ($class, $ip, $port) = @_; 7 | return bless { 8 | sock => undef, # undef if not yet connected, else socket to host 9 | ip => $ip, 10 | port => $port, 11 | }, $class; 12 | } 13 | 14 | # returns (or connects to & returns) raw socket to mogstored. 15 | sub sock { 16 | my ($self, $timeout) = @_; 17 | return $self->{sock} if $self->{sock}; 18 | return $self->{sock} = IO::Socket::INET->new(PeerAddr => $self->{ip}, 19 | PeerPort => $self->{port}, 20 | Timeout => $timeout); 21 | } 22 | 23 | sub sock_if_connected { 24 | my $self = shift; 25 | return $self->{sock}; 26 | } 27 | 28 | sub mark_dead { 29 | my $self = shift; 30 | $self->{sock} = undef; 31 | } 32 | 33 | 1; 34 | -------------------------------------------------------------------------------- /makedocs.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | 5 | my $base = "/home/lj/htdocs/dev/mogdocs/"; 6 | my $pshb = Goats->new; 7 | $pshb->batch_convert([qw(mogstored mogilefsd lib)], $base); 8 | 9 | package Goats; 10 | 11 | use strict; 12 | use base 'Pod::Simple::HTMLBatch'; 13 | 14 | sub modnames2paths { 15 | my ($self, $dirs) = @_; 16 | 17 | my @files; 18 | my @dirs; 19 | 20 | foreach my $path (@{$dirs || []}) { 21 | if (-f $path) { 22 | push @files, $path; 23 | } else { 24 | push @dirs, $path; 25 | } 26 | } 27 | 28 | my $m2p = $self->SUPER::modnames2paths(\@dirs); 29 | 30 | foreach my $file (@files) { 31 | my ($tail) = $file =~ m!([^/]+)\z!; 32 | $m2p->{$tail} = $file; 33 | } 34 | 35 | # these are symlinks in brad's lib 36 | foreach my $k (keys %$m2p) { 37 | delete $m2p->{$k} if $k eq "Danga::blib::lib::Danga::Socket" || $k eq "Danga::Socket"; 38 | } 39 | 40 | return $m2p; 41 | } 42 | -------------------------------------------------------------------------------- /debian/mogstored.postinst: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | PKG=mogstored 4 | 5 | . /usr/share/debconf/confmodule || exit 0 6 | 7 | 8 | set -e 9 | 10 | case "$1" in 11 | configure) 12 | 13 | if [ ! -e /etc/mogilefs/mogstored.conf ] 14 | then 15 | mkdir -p /etc/mogilefs 16 | cp /usr/share/doc/mogstored/examples/mogstored.conf /etc/mogilefs/mogstored.conf 17 | 18 | db_get $PKG/docroot 19 | MOGSTORED_DOCROOT=$RET 20 | db_get $PKG/runasuser 21 | RUNASUSER="$RET" 22 | 23 | if [ ! -d "$MOGSTORED_DOCROOT" ] 24 | then 25 | 26 | mkdir -p $MOGSTORED_DOCROOT 27 | chown $RUNASUSER $MOGSTORED_DOCROOT 28 | chmod 755 $MOGSTORED_DOCROOT 29 | fi 30 | 31 | perl -pi -e "s|#MOGSTORED_DOCROOT|$MOGSTORED_DOCROOT|" /etc/mogilefs/mogstored.conf 32 | 33 | fi 34 | 35 | 36 | ;; 37 | 38 | abort-upgrade|abort-remove|abort-deconfigure) 39 | 40 | ;; 41 | 42 | *) 43 | echo "postinst called with unknown argument \`$1'" >&2 44 | exit 1 45 | ;; 46 | esac 47 | db_stop 48 | 49 | #DEBHELPER# 50 | -------------------------------------------------------------------------------- /doc/pluggable-replication-policies.txt: -------------------------------------------------------------------------------- 1 | NOTE: it's quite likely you don't need to know any of this. but since 2 | you're here... 3 | 4 | NOTE: there is currently no way to change a class's replication policy, 5 | except modifying the database, like so: 6 | 7 | ALTER TABLE class 8 | SET replpolicy='Union(MultipleHosts(3), OnDevice(13))' 9 | WHERE dmid=3 AND classid=1; 10 | 11 | Yes, we know this is sub-optimal. A mogadm command should be 12 | done in the future. 13 | 14 | About replication policies strings: 15 | 16 | -- if you don't have a colon in a policy, "MogileFS::ReplicationPolicy::" 17 | is prepended to the class name 18 | 19 | -- if a class doesn't have a replpolicy value, the historical default 20 | is used: "MultipleHosts()". see MogileFS::ReplicationPolicy::MultipleHosts 21 | for what that does. 22 | 23 | -- a replication policy of "MultipleHosts()" uses the class's "mindevcount" 24 | column. but an explicit value, like "MultipleHosts(3)" will ignore the 25 | configured "mindevcount" 26 | 27 | -------------------------------------------------------------------------------- /doc/build-debian-package.txt: -------------------------------------------------------------------------------- 1 | How to build mogilefsd and mogstored as debian packages 2 | ======================================================= 3 | 4 | 1. Checkout or unpack the source code 5 | 6 | 2. Make sure all build-required packages are installed: 7 | 8 | cd server 9 | grep Build debian/control 10 | 11 | Install any packages listed on that line which are not presently installed. 12 | You will also need the dpkg-dev and fakeroot packages installed 13 | 14 | 3. Do: 15 | 16 | dpkg-buildpackage -rfakeroot 17 | 18 | If all went well you should see several files in the parent directory, 19 | such as: 20 | 21 | -rw-r--r-- 1 user user 517 Jun 22 09:27 mogilefs-server_1.00-2.dsc 22 | -rw-r--r-- 1 user user 271962 Jun 22 09:27 mogilefs-server_1.00-2.tar.gz 23 | -rw-r--r-- 1 user user 1659 Jun 22 09:27 mogilefs-server_1.00-2_i386.changes 24 | -rw-r--r-- 1 user user 135944 Jun 22 09:27 mogilefsd_1.00-2_all.deb 25 | -rw-r--r-- 1 user user 23988 Jun 22 09:27 mogstored_1.00-2_all.deb 26 | 27 | 4. You can now install the debian packages with: 28 | 29 | dpkg -i mogstored_1.00-2_all.deb 30 | dpkg -i mogilefsd_1.00-2_all.deb 31 | -------------------------------------------------------------------------------- /lib/Mogstored/HTTPServer.pm: -------------------------------------------------------------------------------- 1 | package Mogstored::HTTPServer; 2 | use strict; 3 | sub new { 4 | my ($class, %opts) = @_; 5 | my $self = bless {}, $class; 6 | $self->{docroot} = delete $opts{docroot}; 7 | $self->{listen} = delete $opts{listen}; 8 | $self->{maxconns} = delete $opts{maxconns}; 9 | $self->{bin} = delete $opts{bin}; 10 | die "unknown opts" if %opts; 11 | return $self; 12 | } 13 | 14 | sub start { 15 | my $self = shift; 16 | die "start not implemented for $self"; 17 | } 18 | 19 | sub pre_daemonize { 20 | my $self = shift; 21 | } 22 | 23 | sub post_daemonize { 24 | my $self = shift; 25 | } 26 | 27 | sub listen_port { 28 | my $self = shift; 29 | my $port = $self->{listen}; 30 | $port =~ s/^.+://; 31 | die "not numeric port?" unless $port =~ /^\d+$/; 32 | return $port; 33 | } 34 | 35 | sub bind_ip { 36 | my $self = shift; 37 | if ($self->{listen} =~ /^(.+):\d+$/) { 38 | return $1; 39 | } elsif ($self->{listen} =~ /^\d+$/) { 40 | return "0.0.0.0"; 41 | } else { 42 | die "Bogus listen value?"; 43 | } 44 | } 45 | 46 | 1; 47 | -------------------------------------------------------------------------------- /doc/testing.txt: -------------------------------------------------------------------------------- 1 | How to test MogileFS 2 | -------------------- 3 | Automated tests 4 | =============== 5 | $ perl Makefile.PL 6 | $ MOGTEST_DBTYPE= make test 7 | Where dbtype is one of MySQL (default), PostGres. 8 | 9 | You should get output similar to the following on success: 10 | 11 | ... 12 | All tests successful, 1 test skipped. 13 | Files=10, Tests=160, 31 wallclock secs ( 6.22 cusr + 3.39 csys = 9.61 CPU) 14 | 15 | 16 | The only test that should be skipped is t/20-filepaths. If you get other tests 17 | being skipped, something is wrong! 18 | 19 | The automated testing makes the assumption that the database can be accessed 20 | as the default local DB administrator without a password. The relevant line of 21 | the follow can be used to test if this assumption is valid: 22 | $ mysql -uroot 23 | OR 24 | $ psql -Upostgres 25 | 26 | Manual tests 27 | ============ 28 | If you only want to run some part of the test suite, or you want detailed 29 | output as to why a test failed, you can run as follows: 30 | $ MOGTEST_DBTYPE= perl -Ilib t/.t 31 | Where dbtype is one of MySQL (default), PostGres. 32 | Where foobar is one of the *.t files from t/. 33 | -------------------------------------------------------------------------------- /debian/control: -------------------------------------------------------------------------------- 1 | Source: mogilefs-server 2 | Section: perl 3 | Priority: optional 4 | Maintainer: Jonathan Steinert 5 | Build-Depends-Indep: libstring-crc32-perl 6 | Standards-Version: 3.6.1.0 7 | 8 | Package: mogstored 9 | Architecture: all 10 | Depends: ${perl:Depends}, debhelper (>= 4.1.40), libperlbal-perl, libio-aio-perl, debconf (>= 1.2.0) 11 | Suggests: mogilefs-utils 12 | Description: storage node daemon for MogileFS 13 | Mogstored is a storage node daemon for MogileFS, the open-source 14 | application-level distributed filesystem from Danga Interactive. 15 | 16 | Package: mogilefsd 17 | Architecture: all 18 | Depends: ${perl:Depends}, debhelper (>= 4.1.40), libdbd-mysql-perl, libdbi-perl, debconf (>= 1.2.0), libnet-netmask-perl, libwww-perl 19 | Suggests: mogilefs-utils 20 | Description: scalable distributed filesystem from Danga Interactive 21 | MogileFS is an open-source, application-level distributed filesystem. It 22 | creates a host-neutral, filesystem-agnostic method of distributing files 23 | that has many advantages over NFS and single-machine raid. This set 24 | of utilities is very scalable and can handle Livejournal.com's load, for 25 | which it was designed. 26 | -------------------------------------------------------------------------------- /doc/memcache-support.txt: -------------------------------------------------------------------------------- 1 | An oft-requested feature, now implemented, is memcached support within 2 | the tracker, in particular to speed up get_paths requests and reduce 3 | load on the database. 4 | 5 | After years of saying it's stupid, I finally implemented it, but I 6 | still maintain it's (usually) stupid. 7 | 8 | Really, you should cache get_paths requests in your application, 9 | avoiding an extra round-trip to the trackers that could be avoided on 10 | a cache hit. 11 | 12 | That is, you should do: 13 | 14 | 1) app <-> memcache 15 | 16 | Rather than: 17 | 18 | 2) app <-> tracker <-> memcache 19 | 20 | Although, if 1) is too hard, it's true that 2) is cheaper than 3): 21 | 22 | 3) app <-> tracker <-> db. 23 | 24 | So now you have lots of options! 25 | 26 | To use memcached support on get_paths requests, telnet to one of your trackers and do: 27 | 28 | set_server_setting key=memcache_servers&value=127.0.0.1:11211 29 | 30 | (where value is a comma-separated list, if you have multiple) 31 | 32 | And then all future get_paths requests with noverify=1 (which now 33 | doubles as the "memcached is okay" flag) will use memcache. 34 | 35 | All this may change in the future, but the instructions given here 36 | will remain compatible if things do change. 37 | 38 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Util.pm: -------------------------------------------------------------------------------- 1 | # misc util functions 2 | # 3 | 4 | package Perlbal::Util; 5 | use strict; 6 | use warnings; 7 | no warnings qw(deprecated); 8 | 9 | sub durl { 10 | my ($txt) = @_; 11 | $txt =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 12 | return $txt; 13 | } 14 | 15 | =head2 C< rebless > 16 | 17 | Safely re-bless a locked (use fields) hash into another package. Note 18 | that for our convenience elsewhere the set of allowable keys for the 19 | re-blessed hash will be the union of the keys allowed by its old package 20 | and those allowed for the package into which it is blessed. 21 | 22 | =cut 23 | 24 | BEGIN { 25 | if ($] >= 5.010) { 26 | eval q{ 27 | use Hash::Util qw(legal_ref_keys unlock_ref_keys lock_ref_keys) 28 | }; 29 | *rebless = sub { 30 | my ($obj, $pkg) = @_; 31 | my @keys = legal_ref_keys($obj); 32 | unlock_ref_keys($obj); 33 | bless $obj, $pkg; 34 | lock_ref_keys($obj, @keys, 35 | legal_ref_keys(fields::new($pkg))); 36 | return $obj; 37 | }; 38 | } 39 | else { 40 | *rebless = sub { 41 | my ($obj, $pkg) = @_; 42 | return bless $obj, $pkg; 43 | }; 44 | } 45 | } 46 | 47 | 1; 48 | 49 | # Local Variables: 50 | # mode: perl 51 | # c-basic-indent: 4 52 | # indent-tabs-mode: nil 53 | # End: 54 | -------------------------------------------------------------------------------- /conf/mogilefsd.conf: -------------------------------------------------------------------------------- 1 | #daemonize = 1 2 | # Database connection information 3 | db_dsn = DBI:mysql:mogilefs:host=127.0.0.1 4 | db_user = username 5 | db_pass = password 6 | # IP:PORT to listen on for mogilefs client requests 7 | listen = 127.0.0.1:7001 8 | # Optional, if you don't define the port above. 9 | conf_port = 7001 10 | # Number of query workers to start by default. 11 | query_jobs = 10 12 | # Number of delete workers to start by default. 13 | delete_jobs = 1 14 | # Number of replicate workers to start by default. 15 | replicate_jobs = 5 16 | # Number of reaper workers to start by default. 17 | # (you don't usually need to increase this) 18 | reaper_jobs = 1 19 | # Number of fsck workers to start by default. 20 | # (these can cause a lot of load when fsck'ing) 21 | #fsck_jobs = 1 22 | # Minimum amount of space to reserve in megabytes 23 | # default: 100 24 | # Consider setting this to be larger than the largest file you 25 | # would normally be uploading. 26 | #min_free_space = 200 27 | # Number of seconds to wait for a storage node to respond. 28 | # default: 2 29 | # Keep this low, so busy storage nodes are quickly ignored. 30 | #node_timeout = 2 31 | # Number of seconds to wait to connect to a storage node. 32 | # default: 2 33 | # Keep this low so overloaded nodes get skipped. 34 | #conn_timeout = 2 35 | # Allow replication to use the secondary node get port, 36 | # if you have apache or similar configured for GET's 37 | #repl_use_get_port = 1 38 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/AutoRemoveLeadingDir.pm: -------------------------------------------------------------------------------- 1 | package Perlbal::Plugin::AutoRemoveLeadingDir; 2 | 3 | # 4 | # this plugin auto-removes a leading directory path component 5 | # in the URL, if it's the name of the directory the webserver 6 | # is rooted at. 7 | # 8 | # if docroot = /home/lj/htdocs/stc/ 9 | # 10 | # and user requests: 11 | # 12 | # /stc/img/foo.jpg 13 | # 14 | # Then this plugin will treat that as if it's a request for /img/foo.jpg. 15 | # 16 | # This is useful for css/js/etc to have an "absolute" pathname for 17 | # peer resources (think css having url(/stc/foo.jpg)) that can be served 18 | # from either a separate hostname (stat.livejournal.com) and using a CDN, 19 | # or from www. when cross-domain js restrictions require it. 20 | 21 | use Perlbal; 22 | use strict; 23 | use warnings; 24 | 25 | sub load { 1 } 26 | sub unload { 1 } 27 | 28 | # called when we're being added to a service 29 | sub register { 30 | my ($class, $svc) = @_; 31 | 32 | $svc->register_hook('AutoRemoveLeadingDir', 'start_serve_request', sub { 33 | my Perlbal::ClientHTTPBase $client = shift; 34 | my $uriref = shift; 35 | 36 | my Perlbal::Service $svc = $client->{service}; 37 | my ($tail) = ($svc->{docroot} =~ m!/([\w-]+)/?$!); 38 | $$uriref =~ s!^/$tail!! if $tail; 39 | return 0; 40 | }); 41 | 42 | return 1; 43 | } 44 | 45 | # called when we're no longer active on a service 46 | sub unregister { 47 | my ($class, $svc) = @_; 48 | return 1; 49 | } 50 | 51 | 1; 52 | -------------------------------------------------------------------------------- /lib/MogileFS/ReplicationPolicy/Union.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::ReplicationPolicy::Union; 2 | use strict; 3 | use base 'MogileFS::ReplicationPolicy'; 4 | use MogileFS::ReplicationRequest qw(ALL_GOOD TOO_GOOD TEMP_NO_ANSWER); 5 | 6 | sub new_from_policy_args { 7 | my ($class, $argref) = @_; 8 | 9 | # first, eat off the open paren 10 | $$argref =~ s/^\s*\(\s*//; 11 | 12 | my @policies; 13 | POLICY: 14 | while (1) { 15 | my $pol = MogileFS::ReplicationPolicy->new_from_policy_string($argref); 16 | push @policies, $pol; 17 | # eat a comma if it's there. 18 | $$argref =~ s/^\s*\,\s*//; 19 | last if $$argref =~ s/^\s*\)\s*//; 20 | } 21 | 22 | return bless { 23 | policies => \@policies, 24 | }, $class; 25 | } 26 | 27 | 28 | sub replicate_to { 29 | my ($self, %args) = @_; 30 | 31 | # TODO: walk $self->{ 32 | die "not implemented"; 33 | } 34 | 35 | 1; 36 | 37 | __END__ 38 | 39 | =head1 NAME 40 | 41 | MogileFS::ReplicationPolicy::Union -- satisfy 2 or more replication policies 42 | 43 | =head1 RULES 44 | 45 | Use this replication policy to satisfy multiple replication policies. 46 | For instance: 47 | 48 | Union(MultipleHosts(3), OnDevice(7)) 49 | 50 | Would make sure a class' files replicate on 3 unique hosts, and are 51 | also on device 7 (which is perhaps your backup device). 52 | 53 | =head1 SEE ALSO 54 | 55 | L 56 | 57 | L 58 | 59 | L 60 | 61 | L 62 | 63 | 64 | 65 | -------------------------------------------------------------------------------- /t/hosts-devices.t: -------------------------------------------------------------------------------- 1 | # -*-perl-*- 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use FindBin qw($Bin); 7 | 8 | use MogileFS::Server; 9 | use MogileFS::Util qw(error_code); 10 | use MogileFS::Test; 11 | 12 | my $sto = eval { temp_store(); }; 13 | if ($sto) { 14 | plan tests => 18; 15 | } else { 16 | plan skip_all => "Can't create temporary test database: $@"; 17 | exit 0; 18 | } 19 | 20 | is(scalar MogileFS::Host->hosts, 0, "no hosts at present"); 21 | is(scalar MogileFS::Device->devices, 0, "no devices at present"); 22 | 23 | my $ha = MogileFS::Host->create("a", "10.0.0.1"); 24 | ok($ha, "made hostA"); 25 | my $hb = MogileFS::Host->create("b", "10.0.0.2"); 26 | ok($hb, "made hostB"); 27 | ok(!eval{ MogileFS::Host->create("b", "10.0.0.3") }, "can't dup hostB's name"); 28 | is(error_code($@), "dup", "yup, was a dup"); 29 | ok(!eval{ MogileFS::Host->create("c", "10.0.0.2") }, "can't dup hostB's IP"); 30 | is(error_code($@), "dup", "yup, was a dup"); 31 | 32 | ok($hb->set_ip("10.0.0.4"), "set IP"); 33 | is($hb->ip, "10.0.0.4", "IP matches"); 34 | ok(!eval{$hb->set_ip("10.0.0.1")}, "IP's taken"); 35 | is(error_code($@), "dup", "yup, was a dup"); 36 | 37 | is(scalar MogileFS::Host->hosts, 2, "2 hosts now"); 38 | ok($ha->delete, "deleted hostA"); 39 | is(scalar MogileFS::Host->hosts, 1, "1 host now"); 40 | 41 | my $da = MogileFS::Device->create(devid => 1, 42 | hostid => $hb->id, 43 | status => "alive"); 44 | ok($da, "made dev1"); 45 | ok($da->not_on_hosts($ha), "dev1 not on ha"); 46 | ok(!$da->not_on_hosts($hb), "dev1 is on hb"); 47 | 48 | 49 | 50 | 51 | -------------------------------------------------------------------------------- /lib/Mogstored/HTTPServer/Lighttpd.pm: -------------------------------------------------------------------------------- 1 | package Mogstored::HTTPServer::Lighttpd; 2 | use strict; 3 | use base 'Mogstored::HTTPServer'; 4 | use File::Temp (); 5 | 6 | sub start { 7 | my $self = shift; 8 | my $exe = $self->{bin}; 9 | 10 | if ($exe && ! -x $exe) { 11 | die "Provided lighttpd path $exe not valid.\n"; 12 | } 13 | unless ($exe) { 14 | my @loc = qw(/usr/local/sbin/lighttpd 15 | /usr/sbin/lighttpd 16 | /usr/local/bin/lighttpd 17 | /usr/bin/lighttpd 18 | ); 19 | foreach my $loc (@loc) { 20 | $exe = $loc; 21 | last if -x $exe; 22 | } 23 | unless (-x $exe) { 24 | die "Can't find lighttpd in @loc\n"; 25 | } 26 | } 27 | 28 | my $pid = fork(); 29 | die "Can't fork: $!" unless defined $pid; 30 | 31 | if ($pid) { 32 | $self->{pid} = $pid; 33 | Mogstored->on_pid_death($pid => sub { 34 | die "lighttpd died"; 35 | }); 36 | return; 37 | } 38 | 39 | my ($fh, $filename) = File::Temp::tempfile(); 40 | $self->{temp_conf_file} = $filename; 41 | 42 | my $portnum = $self->listen_port; 43 | my $bind_ip = $self->bind_ip; 44 | 45 | print $fh qq{ 46 | server.document-root = "$self->{docroot}" 47 | server.port = $portnum 48 | server.bind = "$bind_ip" 49 | server.modules = ( "mod_webdav", "mod_status" ) 50 | webdav.activate = "enable" 51 | status.status-url = "/" 52 | }; 53 | 54 | exec $exe, "-D", "-f", $filename; 55 | } 56 | 57 | sub DESTROY { 58 | my $self = shift; 59 | unlink $self->{temp_conf_file} if $self->{temp_conf_file}; 60 | } 61 | 62 | 1; 63 | -------------------------------------------------------------------------------- /t/replpolicy-parsing.t: -------------------------------------------------------------------------------- 1 | # -*-perl-*- 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use FindBin qw($Bin); 7 | use Data::Dumper; 8 | 9 | use MogileFS::Server; 10 | use MogileFS::Util qw(error_code); 11 | use MogileFS::Test; 12 | 13 | plan tests => 31; 14 | 15 | my $obj; 16 | 17 | $obj = MogileFS::ReplicationPolicy->new_from_policy_string("MultipleHosts(5)"); 18 | isa_ok($obj, "MogileFS::ReplicationPolicy::MultipleHosts", "got a multiple hosts policy") 19 | or die "can't proceed"; 20 | is($obj->mindevcount, 5, "got correct devcount"); 21 | 22 | $obj = MogileFS::ReplicationPolicy->new_from_policy_string("MultipleHosts()"); 23 | isa_ok($obj, "MogileFS::ReplicationPolicy::MultipleHosts", "got a multiple hosts policy") 24 | or die "can't proceed"; 25 | 26 | foreach my $str ("Union(MultipleHosts(5), MultipleHosts(2))", 27 | "Union(MultipleHosts(5), MultipleHosts(2), )", 28 | "Union( MultipleHosts(5), MultipleHosts(2) )", 29 | "Union(MultipleHosts( 5),MultipleHosts(2))", 30 | "Union ( MultipleHosts ( 5 ) , MultipleHosts ( 2 ) )", 31 | "Union ( MultipleHosts ( 5 ) ,\n MultipleHosts ( 2 ) )", 32 | "Union ( MultipleHosts ( 5 ) , \n MultipleHosts ( 2 ), )", 33 | ) 34 | { 35 | $obj = MogileFS::ReplicationPolicy->new_from_policy_string($str); 36 | isa_ok($obj, "MogileFS::ReplicationPolicy::Union") or die "Failed to parse: $str"; 37 | is(scalar @{$obj->{policies}}, 2, "got 2 sub policies"); 38 | isa_ok($obj->{policies}[0], "MogileFS::ReplicationPolicy::MultipleHosts"); 39 | isa_ok($obj->{policies}[1], "MogileFS::ReplicationPolicy::MultipleHosts"); 40 | } 41 | 42 | 43 | -------------------------------------------------------------------------------- /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 | export PERL_MM_USE_DEFAULT=1 11 | 12 | ifndef PERL 13 | PERL = /usr/bin/perl 14 | endif 15 | 16 | TMP =$(CURDIR)/debian/tmp 17 | 18 | build: build-stamp 19 | build-stamp: 20 | dh_testdir 21 | $(PERL) Makefile.PL verbose INSTALLDIRS=vendor 22 | $(MAKE) 23 | 24 | touch build-stamp 25 | 26 | clean: 27 | dh_testdir 28 | dh_testroot 29 | 30 | -$(MAKE) distclean 31 | dh_clean build-stamp install-stamp 32 | 33 | install: build install-stamp 34 | install-stamp: 35 | dh_testdir 36 | dh_testroot 37 | dh_clean -k 38 | 39 | dh_installdirs -A 40 | 41 | # $(MAKE) test 42 | $(MAKE) pure_install DESTDIR=$(TMP) PREFIX=/usr 43 | 44 | find $(TMP) -name .packlist -exec rm '{}' \; 45 | find $(TMP) -depth -type d -empty -exec rmdir '{}' \; 46 | 47 | # destroy all the mogdeps stuff 48 | rm -rf $(TMP)/usr/share/perl5/mogdeps 49 | rm -rf $(TMP)/usr/share/man/man3/mogdeps::* 50 | 51 | dh_install --sourcedir=$(TMP) --fail-missing 52 | 53 | touch install-stamp 54 | 55 | binary-arch: 56 | # Nothing to do here, yet. 57 | binary-indep: build install 58 | dh_testdir 59 | dh_testroot 60 | dh_installexamples 61 | dh_installdocs 62 | dh_installman 63 | dh_installdebconf 64 | dh_installinit 65 | dh_installchangelogs 66 | dh_link 67 | dh_strip 68 | dh_compress 69 | dh_fixperms 70 | dh_installdeb 71 | dh_perl 72 | dh_gencontrol 73 | dh_md5sums 74 | dh_builddeb 75 | 76 | binary: binary-indep binary-arch 77 | .PHONY: build clean binary-indep binary-arch binary install configure 78 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/AtomInject.pm: -------------------------------------------------------------------------------- 1 | package Perlbal::Plugin::AtomInject; 2 | 3 | use Perlbal; 4 | use strict; 5 | use warnings; 6 | 7 | our @subs; # subscribers 8 | 9 | # called when we're being added to a service 10 | sub register { 11 | my ($class, $svc) = @_; 12 | 13 | $svc->{enable_put} = 1; 14 | 15 | $svc->register_hook('AtomInject', 'handle_put', sub { 16 | my Perlbal::ClientHTTP $self = shift; 17 | my Perlbal::HTTPHeaders $hds = $self->{req_headers}; 18 | return 0 unless $hds; 19 | 20 | return $self->send_response(400, "Invalid method") 21 | unless $hds->request_method eq "PUT"; 22 | 23 | my $uri = $hds->request_uri; 24 | return $self->send_response(400, "Invalid uri") unless $uri =~ /^\//; 25 | $self->{scratch}{path} = $uri; 26 | 27 | # now abort the normal handle_put processing... 28 | return 1; 29 | }); 30 | 31 | $svc->register_hook('AtomInject', 'put_writeout', sub { 32 | my Perlbal::ClientHTTP $self = shift; 33 | return 1 if $self->{content_length_remain}; 34 | 35 | my $data = join("", map { $$_ } @{$self->{read_buf}}); 36 | 37 | # reset our input buffer 38 | $self->{read_buf} = []; 39 | $self->{read_ahead} = 0; 40 | 41 | my $rv = eval { Perlbal::Plugin::AtomStream->InjectFeed(\$data, $self->{scratch}{path}); }; 42 | return $self->send_response(200); 43 | }); 44 | 45 | return 1; 46 | } 47 | 48 | # called when we're no longer active on a service 49 | sub unregister { 50 | my ($class, $svc) = @_; 51 | return 1; 52 | } 53 | 54 | # called when we are loaded 55 | sub load { 56 | return 1; 57 | } 58 | 59 | # called for a global unload 60 | sub unload { 61 | return 1; 62 | } 63 | 64 | 65 | 1; 66 | -------------------------------------------------------------------------------- /lib/Mogstored/HTTPServer/Apache.pm: -------------------------------------------------------------------------------- 1 | package Mogstored::HTTPServer::Apache; 2 | use strict; 3 | use base 'Mogstored::HTTPServer'; 4 | use File::Temp (); 5 | 6 | sub start { 7 | my $self = shift; 8 | my $exe = $self->{bin}; 9 | 10 | if ($exe && ! -x $exe) { 11 | die "Provided apache path $exe not valid.\n"; 12 | } 13 | unless ($exe) { 14 | # TODO: not sure where else common locations are... just guessing 15 | my @loc = qw(/usr/sbin/apache 16 | /usr/sbin/httpd 17 | ); 18 | foreach my $loc (@loc) { 19 | $exe = $loc; 20 | last if -x $exe; 21 | } 22 | unless (-x $exe) { 23 | die "Can't find apache in @loc\n"; 24 | } 25 | } 26 | 27 | my $pid = fork(); 28 | die "Can't fork: $!" unless defined $pid; 29 | 30 | if ($pid) { 31 | $self->{pid} = $pid; 32 | Mogstored->on_pid_death($pid => sub { 33 | die "apache died"; 34 | }); 35 | return; 36 | } 37 | 38 | my ($fh, $filename) = File::Temp::tempfile(); 39 | $self->{temp_conf_file} = $filename; 40 | 41 | my $portnum = $self->listen_port; 42 | my $bind_ip = $self->bind_ip; 43 | 44 | print $fh qq{ 45 | ServerType standalone 46 | ErrorLog /dev/null 47 | LoadModule dav_module /usr/lib/apache/1.3/libdav.so 48 | 49 | Listen 7500 50 | 51 | DocumentRoot $self->{docroot} 52 | 53 | {docroot}> 54 | Options +Indexes +FollowSymLinks 55 | 56 | 57 | 58 | DAV On 59 | 60 | 61 | 62 | }; 63 | 64 | exec $exe, "-F", "-f", $filename; 65 | } 66 | 67 | sub DESTROY { 68 | my $self = shift; 69 | unlink $self->{temp_conf_file} if $self->{temp_conf_file}; 70 | } 71 | 72 | 1; 73 | -------------------------------------------------------------------------------- /lib/MogileFS/DeviceState.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::DeviceState; 2 | use strict; 3 | 4 | # properties are: 5 | # read: can it serve traffic? 6 | # drain: should its file_on be drained? 7 | # new_files: does it get new files 8 | # write: is it writable? (for instance, for deletes) 9 | # dead: permanently dead, files lost, not coming back to service 10 | my $singleton = { 11 | 'alive' => bless({ 12 | read => 1, 13 | write => 1, 14 | monitor => 1, 15 | new_files => 1, 16 | }), 17 | 'dead' => bless({ 18 | # Note that 'dead' doesn't include 'drain', since that's 19 | # handled (specially) by the reap job. 20 | dead => 1, 21 | }), 22 | 'down' => bless({ 23 | }), 24 | 'readonly' => bless({ 25 | read => 1, 26 | monitor => 1, 27 | }), 28 | 'drain' => bless({ 29 | read => 1, 30 | write => 1, 31 | drain => 1, 32 | monitor => 1, 33 | }), 34 | }; 35 | 36 | # returns undef if unknown state 37 | sub of_string { 38 | my ($class, $state) = @_; 39 | return $state ? $singleton->{$state} : undef; 40 | } 41 | 42 | sub should_drain { $_[0]->{drain} } 43 | sub can_delete_from { $_[0]->{write} } 44 | sub can_read_from { $_[0]->{read} } 45 | sub should_get_new_files { $_[0]->{new_files} } 46 | sub should_get_repl_files { $_[0]->{new_files} } 47 | sub should_have_files { ! ($_[0]->{drain} || $_[0]->{dead}) } 48 | sub should_monitor { $_[0]->{monitor} } 49 | 50 | # named inconveniently so it's not taken to mean equalling string 51 | # "dead" 52 | sub is_perm_dead { $_[0]->{dead} } 53 | 54 | sub should_wake_reaper { $_[0]->{dead} } 55 | 56 | sub should_fsck_search_on { 57 | my $ds = shift; 58 | return $ds->can_read_from || $ds->should_have_files; 59 | } 60 | 61 | 1; 62 | 63 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/Queues.pm: -------------------------------------------------------------------------------- 1 | ########################################################################### 2 | # simple queue length header inclusion plugin 3 | ########################################################################### 4 | 5 | package Perlbal::Plugin::Queues; 6 | 7 | use strict; 8 | use warnings; 9 | no warnings qw(deprecated); 10 | 11 | # called when we're being added to a service 12 | sub register { 13 | my ($class, $svc) = @_; 14 | 15 | # more complicated statistics 16 | $svc->register_hook('Queues', 'backend_client_assigned', sub { 17 | my Perlbal::BackendHTTP $obj = shift; 18 | my Perlbal::HTTPHeaders $hds = $obj->{req_headers}; 19 | my Perlbal::Service $svc = $obj->{service}; 20 | return 0 unless defined $hds && defined $svc; 21 | 22 | # determine age of oldest (first in line) 23 | my $now = time; 24 | my Perlbal::ClientProxy $cp = $svc->{waiting_clients}->[0]; 25 | my $age = defined $cp ? ($now - $cp->{last_request_time}) : 0; 26 | 27 | # now do the age of the high priority queue 28 | $cp = $svc->{waiting_clients_highpri}->[0]; 29 | my $hpage = defined $cp ? ($now - $cp->{last_request_time}) : 0; 30 | 31 | # setup the queue length headers 32 | $hds->header('X-Queue-Count', scalar(@{$svc->{waiting_clients}})); 33 | $hds->header('X-Queue-Age', $age); 34 | $hds->header('X-HP-Queue-Count', scalar(@{$svc->{waiting_clients_highpri}})); 35 | $hds->header('X-HP-Queue-Age', $hpage); 36 | return 0; 37 | }); 38 | 39 | return 1; 40 | } 41 | 42 | # called when we're no longer active on a service 43 | sub unregister { 44 | my ($class, $svc) = @_; 45 | 46 | # clean up time 47 | $svc->unregister_hooks('Queues'); 48 | return 1; 49 | } 50 | 51 | # we don't do anything in here 52 | sub load { return 1; } 53 | sub unload { return 1; } 54 | 55 | 1; 56 | -------------------------------------------------------------------------------- /debian/po/templates.pot: -------------------------------------------------------------------------------- 1 | # 2 | # Translators, if you are not familiar with the PO format, gettext 3 | # documentation is worth reading, especially sections dedicated to 4 | # this format, e.g. by running: 5 | # info -n '(gettext)PO Files' 6 | # info -n '(gettext)Header Entry' 7 | # 8 | # Some information specific to po-debconf are available at 9 | # /usr/share/doc/po-debconf/README-trans 10 | # or http://www.debian.org/intl/l10n/po-debconf/README-trans 11 | # 12 | # Developers do not need to manually edit POT or PO files. 13 | # 14 | #, fuzzy 15 | msgid "" 16 | msgstr "" 17 | "Project-Id-Version: PACKAGE VERSION\n" 18 | "Report-Msgid-Bugs-To: \n" 19 | "POT-Creation-Date: 2005-01-19 13:36-0500\n" 20 | "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" 21 | "Last-Translator: FULL NAME \n" 22 | "Language-Team: LANGUAGE \n" 23 | "MIME-Version: 1.0\n" 24 | "Content-Type: text/plain; charset=CHARSET\n" 25 | "Content-Transfer-Encoding: 8bit\n" 26 | 27 | #. Type: string 28 | #. Default 29 | #: ../mogstored.templates:3 30 | msgid "/var/mogdata" 31 | msgstr "" 32 | 33 | #. Type: string 34 | #. Description 35 | #: ../mogstored.templates:4 36 | msgid "Document root for mogstored:" 37 | msgstr "" 38 | 39 | #. Type: string 40 | #. Description 41 | #: ../mogstored.templates:4 42 | msgid "The mogstored daemon needs a directory for the root of its filetree." 43 | msgstr "" 44 | 45 | #. Type: string 46 | #. Default 47 | #: ../mogilefsd.templates:3 48 | msgid "mogilefsd" 49 | msgstr "" 50 | 51 | #. Type: string 52 | #. Description 53 | #: ../mogilefsd.templates:4 54 | msgid "User to run mogilefsd as:" 55 | msgstr "" 56 | 57 | #. Type: string 58 | #. Description 59 | #: ../mogilefsd.templates:4 60 | msgid "" 61 | "The mogilefsd storage engine cannot be run as root. What user should it be " 62 | "run as? This user will be created for you as a system user if it does not " 63 | "yet exist." 64 | msgstr "" 65 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 3 | # Perl Makefile for MogileFS 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 | my $exefiles = ["mogstored", "mogilefsd", "mogdbsetup", "mogautomount"]; 15 | $exefiles = ["mogstored"] if exists $ENV{DANGABUILD_MOGSTOREDONLY}; 16 | $exefiles = ["mogilefsd"] if exists $ENV{DANGABUILD_MOGILEFSDONLY}; 17 | 18 | WriteMakefile( 19 | NAME => 'mogilefs-server', 20 | VERSION_FROM => 'lib/MogileFS/Server.pm', 21 | AUTHOR => 'Brad Fitzpatrick ', 22 | ABSTRACT_FROM => 'lib/MogileFS/Server.pm', 23 | EXE_FILES => $exefiles, 24 | PREREQ_PM => { 25 | 'Danga::Socket' => '1.56', 26 | 'Perlbal' => '1.76', 27 | 'Sys::Syslog' => 0, 28 | 'Sys::Syscall' => '0.22', 29 | 'Getopt::Long' => 0, 30 | 'Symbol' => 0, 31 | 'Net::Netmask' => 0, 32 | fields => 0, 33 | 'IO::AIO' => 0, 34 | 'MogileFS::Client' => 0, 35 | DBI => 0, 36 | }, 37 | META_MERGE => { 38 | no_index => { 39 | directory => 'lib/mogdeps', 40 | package => ['ProcessHandle', 'TrackerHandle', 'MogstoredHandle', 41 | 'MogPath', 'Mgd'], 42 | }, 43 | resources => { 44 | homepage => 'http://danga.com/mogilefs/', 45 | bugtracker => 'http://rt.cpan.org/Public/Dist/Display.html?Name=mogilefs-server', 46 | repository => 'http://code.sixapart.com/svn/mogilefs/', 47 | MailingList => 'http://groups.google.com/group/mogile', 48 | }, 49 | 50 | }, 51 | ); 52 | 53 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/ChunkedUploadState.pm: -------------------------------------------------------------------------------- 1 | package Perlbal::ChunkedUploadState; 2 | use strict; 3 | 4 | sub new { 5 | my ($pkg, %args) = @_; 6 | my $self = bless { 7 | 'buf' => '', 8 | 'bytes_remain' => 0, # remaining in chunk (ignoring final 2 byte CRLF) 9 | }, $pkg; 10 | foreach my $k (qw(on_new_chunk on_disconnect on_zero_chunk)) { 11 | $self->{$k} = (delete $args{$k}) || sub {}; 12 | } 13 | die "bogus args" if %args; 14 | return $self; 15 | } 16 | 17 | sub on_readable { 18 | my ($self, $ds) = @_; 19 | my $rbuf = $ds->read(131072); 20 | unless (defined $rbuf) { 21 | $self->{on_disconnect}->(); 22 | return; 23 | } 24 | 25 | $self->{buf} .= $$rbuf; 26 | 27 | while ($self->drive_machine) {} 28 | } 29 | 30 | # returns 1 if progress was made parsing buffer 31 | sub drive_machine { 32 | my $self = shift; 33 | 34 | my $buflen = length($self->{buf}); 35 | return 0 unless $buflen; 36 | 37 | if (my $br = $self->{bytes_remain}) { 38 | my $extract = $buflen > $br ? $br : $buflen; 39 | my $ch = substr($self->{buf}, 0, $extract, ''); 40 | $self->{bytes_remain} -= $extract; 41 | die "assert" if $self->{bytes_remain} < 0; 42 | $self->{on_new_chunk}->(\$ch); 43 | return 1; 44 | } 45 | 46 | return 0 unless $self->{buf} =~ s/^(?:\r\n)?([0-9a-fA-F]+)(?:;.*)?\r\n//; 47 | $self->{bytes_remain} = hex($1); 48 | 49 | if ($self->{bytes_remain} == 0) { 50 | # FIXME: new state machine state for trailer parsing/discarding. 51 | # (before we do on_zero_chunk). for now, though, just assume 52 | # no trailers and throw away the extra post-trailer \r\n that 53 | # is probably in this packet. hacky. 54 | $self->{buf} =~ s/^\r\n//; 55 | $self->{hit_zero} = 1; 56 | $self->{on_zero_chunk}->(); 57 | return 0; 58 | } 59 | return 1; 60 | } 61 | 62 | sub hit_zero_chunk { $_[0]{hit_zero} } 63 | 64 | 1; 65 | -------------------------------------------------------------------------------- /lib/MogileFS/ReplicationPolicy.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::ReplicationPolicy; 2 | use strict; 3 | 4 | =head1 NAME 5 | 6 | MogileFS::ReplicationPolicy - base class for file replication policies 7 | 8 | =head1 DESCRIPTION 9 | 10 | A MogileFS replication policy class implements policy for how files 11 | should be replicated around. 12 | 13 | .... 14 | 15 | =cut 16 | 17 | # parse a policy description string, instantiating object(s) along the way 18 | # given $str can be either a scalar, or a scalarref that's eaten away as it's parsed. 19 | sub new_from_policy_string { 20 | my ($class, $str_a) = @_; 21 | 22 | # simple case for normal callers: they give us a scalar, but internally 23 | # we work with it as a scalarref that we eat away while parsing. 24 | my $strref = ref $str_a ? $str_a : \$str_a; 25 | 26 | $$strref =~ s/^\s*([\w:]+)// or die "Failed to parse policy string: $$strref"; 27 | my ($polclass) = ($1); 28 | $polclass = "MogileFS::ReplicationPolicy::$polclass" unless $polclass =~ /:/; 29 | 30 | my $rv = eval "use $polclass; 1"; 31 | if ($@ || !$rv) { 32 | die "Failed to load replication policy class $polclass: $@\n"; 33 | } 34 | 35 | return $polclass->new_from_policy_args($strref); 36 | } 37 | 38 | # returns: 39 | # 0: replication sufficient 40 | # undef: no suitable recommendations currently. 41 | # >0: devid to replicate to. 42 | sub replicate_to { 43 | my ($self, %args) = @_; 44 | my $fid = delete $args{fid}; # fid scalar to copy 45 | my $on_devs = delete $args{on_devs}; # arrayref of device objects 46 | my $all_devs = delete $args{all_devs}; # hashref of { devid => MogileFS::Device } 47 | my $failed = delete $args{failed}; # hashref of { devid => 1 } of failed attempts this round 48 | my $min = delete $args{min}; # configured min devcount for this class 49 | 50 | warn "Unknown parameters: " . join(", ", sort keys %args) if %args; 51 | die "Missing parameters" unless $on_devs && $all_devs && $failed && $fid; 52 | 53 | die "UNIMPLEMENTED 'replicate_to' in " . (ref($self) || $self); 54 | } 55 | 56 | 57 | 58 | 1; 59 | -------------------------------------------------------------------------------- /t/store.t: -------------------------------------------------------------------------------- 1 | # -*-perl-*- 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use FindBin qw($Bin); 7 | 8 | use MogileFS::Server; 9 | use MogileFS::Util qw(error_code); 10 | use MogileFS::Test; 11 | 12 | my $sto = eval { temp_store(); }; 13 | if ($sto) { 14 | plan tests => 12; 15 | } else { 16 | plan skip_all => "Can't create temporary test database: $@"; 17 | exit 0; 18 | } 19 | 20 | my $dom = MogileFS::Domain->create("foo"); 21 | ok($dom, "created a domain"); 22 | my $cls = $dom->create_class("classA"); 23 | ok($cls, "created a class"); 24 | 25 | my $df = MogileFS::DevFID->new(100, 200); 26 | ok($df, "made devfid"); 27 | ok($df->add_to_db, "added to db"); 28 | 29 | my $fid = $df->fid; 30 | ok($fid, "got fid from df"); 31 | my @on = $fid->devids; 32 | is(scalar @on, 1, "FID 200 on one device"); 33 | is($on[0], 100, "is correct number"); 34 | 35 | ok($sto->mass_insert_file_on(MogileFS::DevFID->new(1, 101), 36 | MogileFS::DevFID->new(2, 101)), "did mass insert"); 37 | $fid = MogileFS::FID->new(101); 38 | @on = $fid->devids; 39 | is(scalar @on, 2, "FID 101 on 2 devices"); 40 | 41 | # create a tempfile 42 | { 43 | my $fidid = $sto->register_tempfile( 44 | fid => undef, 45 | dmid => $dom->id, 46 | key => "my_tempfile", 47 | classid => $cls->classid, 48 | devids => join(',', 1,2,3), 49 | ); 50 | ok($fidid, "got a fidid"); 51 | 52 | my $fidid2 = eval { 53 | $sto->register_tempfile( 54 | fid => $fidid, 55 | dmid => $dom->id, 56 | key => "my_tempfile", 57 | classid => $cls->classid, 58 | devids => join(',', 1,2,3), 59 | ); 60 | }; 61 | my $errc = error_code($@); 62 | ok(!$fidid2, "didn't get fidid"); 63 | is($errc, "dup", "got a dup into tempfile") 64 | or die "Got error: $@\n"; 65 | } 66 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/NotModified.pm: -------------------------------------------------------------------------------- 1 | package Perlbal::Plugin::NotModified; 2 | 3 | use Perlbal; 4 | use strict; 5 | use warnings; 6 | 7 | # Takes settings in perlbal like: 8 | # SET ss.notmodified.host_pattern = ^example\.com 9 | # 10 | # The value is a regular expression to match against the Host: header on the incoming request. 11 | 12 | sub load { 13 | my $class = shift; 14 | return 1; 15 | } 16 | 17 | sub unload { 18 | my $class = shift; 19 | return 1; 20 | } 21 | 22 | # called when we're being added to a service 23 | sub register { 24 | my ($class, $svc) = @_; 25 | 26 | my $host_check_regex = undef; 27 | 28 | my $start_http_request_hook = sub { 29 | my Perlbal::ClientHTTPBase $client = shift; 30 | my Perlbal::HTTPHeaders $hds = $client->{req_headers}; 31 | return 0 unless $hds; 32 | 33 | my $uri = $hds->request_uri; 34 | 35 | return 0 unless $uri; 36 | 37 | my $host = $hds->header("Host"); 38 | 39 | return 0 unless $host; 40 | return 0 unless $host =~ $host_check_regex; 41 | 42 | my $ims = $hds->header("If-Modified-Since"); 43 | 44 | return 0 unless $ims; 45 | 46 | $client->send_response(304, "Not Modified"); 47 | 48 | return 1; 49 | }; 50 | 51 | # register things to take in configuration regular expressions 52 | $svc->register_setter('NotModified', 'host_pattern', sub { 53 | my ($out, $what, $val) = @_; 54 | return 0 unless $what && $val; 55 | 56 | my $err = sub { 57 | $out->("ERROR: $_[0]") if $out; 58 | return 0; 59 | }; 60 | 61 | unless (length $val) { 62 | $host_check_regex = undef; 63 | $svc->unregister_hooks('NotModified'); 64 | return 1; 65 | } 66 | 67 | $host_check_regex = qr/$val/; 68 | $svc->register_hook('NotModified', 'start_http_request', $start_http_request_hook); 69 | 70 | return 1; 71 | }); 72 | 73 | return 1; 74 | } 75 | 76 | # called when we're no longer active on a service 77 | sub unregister { 78 | my ($class, $svc) = @_; 79 | $svc->unregister_hooks('NotModified'); 80 | $svc->unregister_setters('NotModified'); 81 | return 1; 82 | } 83 | 84 | 1; 85 | -------------------------------------------------------------------------------- /doc/fsck-notes.txt: -------------------------------------------------------------------------------- 1 | What replicate task uses: all new files go with "nexttry" 0, rather than relying on "devcount". 2 | 3 | CREATE TABLE needs_replicate ( 4 | fid INT UNSIGNED NOT NULL PRIMARY KEY, 5 | nexttry INT UNSIGNED NOT NULL, 6 | INDEX (nexttry), 7 | fromdevid INT UNSIGNED, /* NULL means no preference */ 8 | failcount TINYINT UNSIGNED 9 | flags? /* one bit means corrupt, choose source where two files are the same md5? reserved for future use. */ 10 | ); 11 | 12 | server_settings: 13 | 'fsck_enable' {off,locations,quick,full} location=file_on only, quick=file_on + HEAD requests, full=contents 14 | 'fsck_highest_fid_checked' = 15 | 16 | update server_settings SET val=foo WHERE key='highest_fid_inserted' and val < foo; 17 | 18 | CREATE TABLE fsck ( 19 | fid INT UNSIGNED NOT NULL PRIMARY KEY, 20 | nextcheck INT UNSIGNED NOT NULL, 21 | INDEX (nextcheck), 22 | ) 23 | 24 | # todo: replicate_now command to make all needs_replicate files nexttry=0; 25 | # todo: fsck, if no copies, still puts in needs_replicate but with high nexttry time and of course no fromdevid. 26 | 27 | # how often do recheck files? --never, only when they kick it off. 28 | # todo: replication policy saying "not quite happy" goes into "needs_replicate" table for to-be-fixed-later 29 | # todo: stat command to get count of rows in needs_replicate (!repl replacement) 30 | 31 | # provide command to drop fsck table to force global re-indexing 32 | # interface from fsck job to replicate job. or do it ourselves sharing code. (probably sharing code) 33 | # perhaps command-line version is just running: 34 | # mogilefsd --run-only-job=fsck --foreground --verbose 35 | # 36 | 37 | while (1) { 38 | 39 | # create table if not exist. (the fsck table) 40 | 41 | # while (find files to check from fsck table), 42 | # randomize 43 | # check them, inserting into needs_replicate or updating nextcheck time, or deleting if okay. 44 | 45 | # once no more files to check.... 46 | 47 | # find files that are so new they don't have records in fsck 48 | while (max(file) > max(server_settings.fsck._highestfidcheck) && fsck enabled) { 49 | insert into fsck select fid, ? ? ? ? from file where fid > max(fsck) order by fid limit 500 50 | } 51 | } 52 | 53 | -------------------------------------------------------------------------------- /t/domains-classes.t: -------------------------------------------------------------------------------- 1 | # -*-perl-*- 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use FindBin qw($Bin); 7 | 8 | use MogileFS::Server; 9 | use MogileFS::Util qw(error_code); 10 | use MogileFS::Test; 11 | 12 | my $sto = eval { temp_store(); }; 13 | if ($sto) { 14 | plan tests => 26; 15 | } else { 16 | plan skip_all => "Can't create temporary test database: $@"; 17 | exit 0; 18 | } 19 | 20 | is(scalar MogileFS::Domain->domains, 0, "no domains at present"); 21 | 22 | my $dom = MogileFS::Domain->create("foo"); 23 | ok($dom, "created a domain"); 24 | 25 | my $dup = eval { MogileFS::Domain->create("foo") }; 26 | ok(!$dup, "didn't create it"); 27 | is(error_code($@), "dup", "because it was a duplicate domain"); 28 | 29 | is(scalar MogileFS::Domain->domains, 1, "one domain now"); 30 | $dom->delete; 31 | is(scalar MogileFS::Domain->domains, 0, "back to zero domains"); 32 | 33 | $dom = MogileFS::Domain->create("foo"); 34 | ok($dom, "created foo domain again"); 35 | is(scalar MogileFS::Domain->domains, 1, "back to one domain"); 36 | 37 | { 38 | local $Mgd::_T_DOM_HAS_FILES = 1; 39 | ok(!eval{ $dom->delete; }, "failed to delete domain"); 40 | is(error_code($@), "has_files", "because it had files"); 41 | } 42 | 43 | my @classes = $dom->classes; 44 | is(scalar @classes, 1, "one class in domain") 45 | or die; 46 | is($classes[0]->name, "default", "is the default class"); 47 | is($classes[0]->classid, 0, ".. of classid 0"); 48 | ok(defined $classes[0]->classid, ".. which is defined"); 49 | 50 | my $cla = $dom->create_class("classA"); 51 | ok($cla, "created classA"); 52 | is(scalar($dom->classes), 2, "two classes now"); 53 | 54 | my $clb = $dom->create_class("classB"); 55 | ok($clb, "created classB"); 56 | is(scalar($dom->classes), 3, "three classes now"); 57 | 58 | { 59 | my $dup = eval { $dom->create_class("classA") }; # can't create this again 60 | ok(!$dup, "didn't create dup of A"); 61 | is(error_code($@), "dup", "because it was a dup"); 62 | } 63 | 64 | ok($clb->set_name("classB2"), "renamed classB to B2"); 65 | is($clb->name, "classB2", "and it renamed"); 66 | 67 | ok(!eval { $clb->set_name("classA") }, "failed to rename B2 to classA"); 68 | is(error_code($@), "dup", "because it was a dup"); 69 | 70 | ok($clb->delete, "deleted class"); 71 | is(scalar($dom->classes), 2, "two classes now"); 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | -------------------------------------------------------------------------------- /t/mogstored-shutdown.t: -------------------------------------------------------------------------------- 1 | # -*-perl-*- 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use FindBin qw($Bin); 7 | use IO::Socket::INET; 8 | 9 | use MogileFS::Test; 10 | 11 | unless ((`netstat -nap --inet` || "") =~ m!PID/Program!) { 12 | plan skip_all => "netstat output not how expected; skipping test.\n"; 13 | exit 0; 14 | } 15 | 16 | plan tests => 4; 17 | 18 | my $TEST_IP = '127.0.1.1'; 19 | 20 | my $rv; 21 | 22 | use File::Temp; 23 | my $dir = File::Temp::tempdir( CLEANUP => 1 ); 24 | my $ms = eval { create_mogstored($TEST_IP, $dir, "--daemonize") }; 25 | unless (ok($ms, "started daemonized mogstored")) { 26 | # Must wait a moment on startup 27 | select undef, undef, undef, 0.5; 28 | # Now safe 29 | my $exist = eval { exist_pid() }; 30 | warn "exist = $exist\n"; 31 | if ($exist) { 32 | warn "killing existing test mogstored pid of $exist\n"; 33 | kill 9, $exist; 34 | } 35 | die "wasn't able to start up."; 36 | } 37 | 38 | # what's its pid? 39 | my $real_pid = exist_pid(); 40 | 41 | warn "real_pid = $real_pid\n"; 42 | #scalar ; 43 | 44 | my $sock = try(5, 0.5, sub { IO::Socket::INET->new(PeerAddr => "$TEST_IP:7501", 45 | Timeout => 3) }); 46 | ok($sock, "got mgmt connection") or die; 47 | 48 | 49 | print $sock "shutdown\n"; 50 | 51 | my $rin = ''; 52 | vec($rin,fileno($sock),1) = 1; 53 | my $rout; 54 | my $n = select($rout=$rin,undef,undef,2); 55 | is($n, 1, "mgmt port readable"); 56 | 57 | unless ($n == 1) { 58 | kill 9, $real_pid; 59 | die "killed pid of $real_pid\n"; 60 | } 61 | 62 | my $tries = 0; 63 | my $alive; 64 | while ($tries++ < 10 && ($alive = kill(0, $real_pid))) { 65 | select undef, undef, undef, 0.4; 66 | } 67 | ok(!$alive, "gone"); 68 | 69 | 70 | # dies when not able to find 71 | sub exist_pid { 72 | my $netstat = `netstat -nap --inet`; 73 | my $ip = $TEST_IP; 74 | $ip =~ s/\./\\./g; 75 | unless ($netstat =~ m!${ip}:750[10].+LISTEN\s+(\d+)/!) { 76 | die "Couldn't find pid of daemonized process.\n"; 77 | } 78 | return $1; 79 | } 80 | 81 | sub try { 82 | my ($tries, $delay, $code) = @_; 83 | my $try = 0; 84 | while ($try++ < $tries) { 85 | my $ret = $code->(); 86 | return $ret if $ret; 87 | select undef, undef, undef, $delay; 88 | } 89 | return undef; 90 | } 91 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/MaxContentLength.pm: -------------------------------------------------------------------------------- 1 | package Perlbal::Plugin::MaxContentLength; 2 | 3 | =head1 NAME 4 | 5 | Perlbal::Plugin::MaxContentLength - Reject large requests 6 | 7 | =head1 SYNOPSIS 8 | 9 | LOAD MaxContentLength 10 | CREATE SERVICE cgilike 11 | # define a service... 12 | SET max_content_length = 100000 13 | SET plugins = MaxContentLength 14 | ENABLE cgilike 15 | 16 | =head1 DESCRIPTION 17 | 18 | This module rejects requests that are larger than a configured limit. If a 19 | request bears a Content-Length header whose value exceeds the 20 | max_content_length value, the request will be rejected with a 413 "Request 21 | Entity Too Large" error. 22 | 23 | =head1 AUTHOR 24 | 25 | Adam Thomason, Eathomason@sixapart.comE 26 | 27 | =head1 COPYRIGHT AND LICENSE 28 | 29 | Copyright 2008 Six Apart Ltd. 30 | 31 | This module is part of the Perlbal distribution, and as such can be distributed 32 | under the same licence terms as the rest of Perlbal. 33 | 34 | =cut 35 | 36 | use strict; 37 | use warnings; 38 | 39 | use Perlbal; 40 | 41 | sub load { 42 | Perlbal::Service::add_tunable( 43 | max_content_length => { 44 | check_role => '*', 45 | check_type => 'int', 46 | des => "maximum Content-Length allowed, in bytes. 0 for no limit", 47 | default => 0, 48 | }, 49 | ); 50 | return 1; 51 | } 52 | 53 | use constant HANDLE_REQUEST => 0; 54 | use constant IGNORE_REQUEST => 1; 55 | 56 | sub register { 57 | my ($class, $svc) = @_; 58 | 59 | my $cfg = $svc->{extra_config}; 60 | return unless $cfg; 61 | 62 | $svc->register_hook('MaxContentLength', 'start_http_request' => sub { 63 | my $client = shift; 64 | return IGNORE_REQUEST unless $client; 65 | 66 | # allow request if max is disabled 67 | return HANDLE_REQUEST unless $cfg->{max_content_length}; 68 | 69 | my $headers = $client->{req_headers}; 70 | return HANDLE_REQUEST unless $headers; 71 | 72 | # allow requests which don't have a Content-Length header 73 | my $length = $headers->header('content-length'); 74 | return HANDLE_REQUEST unless $length; 75 | 76 | # allow requests under the cap 77 | return HANDLE_REQUEST if $length <= $cfg->{max_content_length}; 78 | 79 | $client->send_response(413, "Content too long.\n"); 80 | return IGNORE_REQUEST; 81 | }); 82 | } 83 | 84 | sub unregister { 85 | my ($class, $svc) = @_; 86 | 87 | $svc->unregister_hooks('MaxContentLength'); 88 | return 1; 89 | } 90 | 91 | 1; 92 | -------------------------------------------------------------------------------- /mogilefsd: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 3 | # MogileFS daemon 4 | # 5 | # Copyright 2004, Danga Interactive 6 | # Copyright 2005-2006, Six Apart Ltd. 7 | # 8 | # See POD at bottom. 9 | 10 | use strict; 11 | use warnings; 12 | use lib 'lib'; 13 | use MogileFS::Server; 14 | 15 | # Rename binary in process list to make init scripts saner 16 | $0 = "mogilefsd"; 17 | 18 | my $s = MogileFS::Server->server; 19 | $s->run; 20 | 21 | 1; 22 | 23 | # Local Variables: 24 | # mode: perl 25 | # c-basic-indent: 4 26 | # indent-tabs-mode: nil 27 | # End: 28 | 29 | __END__ 30 | 31 | =head1 NAME 32 | 33 | mogilefsd -- MogileFS tracker daemon 34 | 35 | =head1 USAGE 36 | 37 | This is the main MogileFS daemon, mogilefsd, also called the 38 | "tracker". All interaction with a MogileFS installation begins by a 39 | client talking to a tracker (you should run several in parallel for 40 | redundancy). 41 | 42 | See L for a client library. 43 | 44 | =head1 ARCHITECTURE 45 | 46 | =head2 Processes 47 | 48 | The mogilefsd daemon is an event-loop in the parent process, handling 49 | with epoll/kqueue/etc (see L) tons of client 50 | connections, while managing a bunch of worker processes underneath. 51 | 52 | The worker processes under mogilefsd include: 53 | 54 | =over 4 55 | 56 | =item B -- implements the MogileFS client/server protocol 57 | 58 | See L. 59 | 60 | =item B -- monitors hosts and devices 61 | 62 | See L. 63 | 64 | =item B -- replicates files 65 | 66 | See L. 67 | 68 | =item B -- deletes files from storage nodes (protocol deletes from namespace are immediate) 69 | 70 | See L. 71 | 72 | =item B -- re-enqueues files for replication when disks are marked dead 73 | 74 | See L. 75 | 76 | =item B -- background filesystem consistency checker 77 | 78 | See L. 79 | 80 | =back 81 | 82 | =head2 Data Storage 83 | 84 | See L. 85 | 86 | =head1 AUTHORS 87 | 88 | Brad Fitzpatrick Ebrad@danga.comE 89 | 90 | Mark Smith Ejunior@danga.comE 91 | 92 | Brad Whitaker Ewhitaker@danga.comE 93 | 94 | =head1 COPYRIGHT 95 | 96 | Copyright 2004, Danga Interactive 97 | Copyright 2005-2006, Six Apart Ltd. 98 | 99 | =head1 LICENSE 100 | 101 | Same terms as Perl itself. Artistic/GPLv2, at your choosing. 102 | 103 | =head1 SEE ALSO 104 | 105 | L -- MogileFS storage daemon 106 | 107 | L 108 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/Include.pm: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | Perlbal::Plugin::Include - Allows multiple, nesting configuration files 4 | 5 | =head1 DESCRIPTION 6 | 7 | This module adds an INCLUDE command to the Perlbal management console 8 | and allows the globbed inclusion of configuration files. 9 | 10 | =head1 SYNOPSIS 11 | 12 | This module provides a Perlbal plugin which can be loaded and used as 13 | follows: 14 | 15 | LOAD include 16 | INCLUDE = /etc/perlbal/my.conf 17 | 18 | You may also specify multiple configuration files a la File::Glob: 19 | 20 | INCLUDE = /foo/bar.conf /foo/quux/*.conf 21 | 22 | =head1 BUGS AND LIMITATIONS 23 | 24 | This module relies entirely on Perlbal::load_config for loading, so if 25 | you have trouble with INCLUDE, be sure you can load the same 26 | configuration without error using "perlbal -c" first. 27 | 28 | Also note that Perlbal::load_config versions 1.60 and below do not use 29 | a local filehandle while reading the configuration file, so this 30 | module overrides that routine on load to allow nested calls. 31 | 32 | =head1 COPYRIGHT AND LICENSE 33 | 34 | Copyright 2008 Eamon Daly 35 | 36 | This module is part of the Perlbal distribution, and as such can be 37 | distributed under the same licence terms as the rest of Perlbal. 38 | 39 | =cut 40 | 41 | package Perlbal::Plugin::Include; 42 | 43 | use strict; 44 | use warnings; 45 | no warnings qw(deprecated); 46 | 47 | # called when we are loaded 48 | sub load { 49 | my $class = shift; 50 | 51 | Perlbal::register_global_hook('manage_command.include', sub { 52 | my $mc = shift->parse(qr/^include\s+=\s+(.+)\s*$/, 53 | "usage: INCLUDE = "); 54 | 55 | my ($glob) = $mc->args; 56 | 57 | for (glob($glob)) { 58 | Perlbal::load_config($_, sub { print STDOUT "$_[0]\n"; }); 59 | } 60 | 61 | return $mc->ok; 62 | }); 63 | 64 | return 1; 65 | } 66 | 67 | # called for a global unload 68 | sub unload { 69 | # unregister our global hooks 70 | Perlbal::unregister_global_hook('manage_command.include'); 71 | 72 | return 1; 73 | } 74 | 75 | # In older versions of Perlbal, load_config uses a typeglob, throwing 76 | # warnings when re-entering. This uses a locally-scoped filehandle. 77 | sub load_config_local { 78 | my ($file, $writer) = @_; 79 | open(my $fh, $file) or die "Error opening config file ($file): $!\n"; 80 | my $ctx = Perlbal::CommandContext->new; 81 | $ctx->verbose(0); 82 | while (my $line = <$fh>) { 83 | $line =~ s/\$(\w+)/$ENV{$1}/g; 84 | return 0 unless Perlbal::run_manage_command($line, $writer, $ctx); 85 | } 86 | close($fh); 87 | return 1; 88 | } 89 | 90 | 1; 91 | -------------------------------------------------------------------------------- /lib/Mogstored/HTTPServer/Perlbal.pm: -------------------------------------------------------------------------------- 1 | package Mogstored::HTTPServer::Perlbal; 2 | use strict; 3 | use base 'Mogstored::HTTPServer'; 4 | use POSIX qw(ENOENT); 5 | use Fcntl qw(SEEK_CUR SEEK_SET SEEK_END O_RDWR O_CREAT O_TRUNC); 6 | 7 | my $OPTMOD_IO_AIO; 8 | BEGIN { 9 | $OPTMOD_IO_AIO = eval "use IO::AIO 1.6 (); 1;"; 10 | } 11 | 12 | sub start { 13 | my $self = shift; 14 | 15 | unless ($OPTMOD_IO_AIO) { 16 | if ($ENV{'MOGSTORED_RUN_WITHOUT_AIO'}) { 17 | warn("WARNING: Running without async IO. Won't run well with many clients.\n"); 18 | } else { 19 | die("ERROR: IO::AIO not installed, so async IO not available. Refusing to run\n". 20 | " unless you set the environment variable MOGSTORED_RUN_WITHOUT_AIO=1\n"); 21 | } 22 | } 23 | 24 | # use AIO channels in Perlbal 25 | Perlbal::AIO::set_file_to_chan_hook(sub { 26 | my $filename = shift; 27 | $filename =~ m{/dev(\d+)\b} or return undef; 28 | return "dev$1"; 29 | }); 30 | 31 | my $xs_conf = ""; 32 | if (eval "use Perlbal::XS::HTTPHeaders (); 1") { 33 | $xs_conf .= "xs enable headers\n" unless defined $ENV{PERLBAL_XS_HEADERS} && ! $ENV{PERLBAL_XS_HEADERS}; 34 | } 35 | 36 | # this is the perlbal configuration only. not the mogstored configuration. 37 | my $pb_conf = " 38 | $xs_conf 39 | SERVER max_connections = $self->{maxconns} 40 | 41 | SET mogstored.listen = $self->{listen} 42 | SET mogstored.dirindexing = 0 43 | SET mogstored.enable_put = 1 44 | SET mogstored.enable_delete = 1 45 | SET mogstored.min_put_directory = 1 46 | SET mogstored.persist_client = 1 47 | ENABLE mogstored 48 | 49 | "; 50 | 51 | Perlbal::run_manage_commands($pb_conf, sub { print STDERR "$_[0]\n"; }); 52 | 53 | unless (Perlbal::Socket->WatchedSockets > 0) { 54 | die "Invalid configuration. (shouldn't happen?) Stopping.\n"; 55 | } 56 | } 57 | 58 | sub pre_daemonize { 59 | my $self = shift; 60 | die "mogstored won't daemonize with \$ENV{MOGSTORED_RUN_WITHOUT_AIO} set.\n" if $ENV{'MOGSTORED_RUN_WITHOUT_AIO'}; 61 | } 62 | 63 | sub post_daemonize { 64 | my $self = shift; 65 | # set number of AIO threads, between 10-100 (for some reason, have to 66 | # set aio threads after daemonizing) 67 | my $aio_threads = _aio_threads(_disks($self->{docroot})); 68 | Perlbal::run_manage_commands("SERVER aio_threads = $aio_threads", sub { print STDERR "$_[0]\n"; }); 69 | } 70 | 71 | sub _disks { 72 | my $root = shift; 73 | opendir(my $dh, $root) or die "Failed to open docroot: $root: $!"; 74 | return scalar grep { /^dev\d+$/ } readdir($dh); 75 | } 76 | 77 | # returns aio threads to use, given a disk count 78 | sub _aio_threads { 79 | my $disks = shift; 80 | my $threads = ($disks || 1) * 10; 81 | return 100 if $threads > 100; 82 | return $threads; 83 | } 84 | 85 | 1; 86 | -------------------------------------------------------------------------------- /lib/MogileFS/Worker/Reaper.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::Worker::Reaper; 2 | # deletes files 3 | 4 | use strict; 5 | use base 'MogileFS::Worker'; 6 | use MogileFS::Util qw(every error debug); 7 | use MogileFS::Config qw(DEVICE_SUMMARY_CACHE_TIMEOUT); 8 | 9 | sub new { 10 | my ($class, $psock) = @_; 11 | my $self = fields::new($class); 12 | $self->SUPER::new($psock); 13 | 14 | return $self; 15 | } 16 | 17 | sub watchdog_timeout { 18 | return 240; 19 | } 20 | 21 | my %all_empty; # devid -> bool, if all empty of files in file_on 22 | 23 | sub work { 24 | my $self = shift; 25 | 26 | every(5, sub { 27 | $self->parent_ping; 28 | 29 | # get db and note we're starting a run 30 | debug("Reaper running; looking for dead devices"); 31 | 32 | foreach my $dev (grep { $_->dstate->is_perm_dead } 33 | MogileFS::Device->devices) 34 | { 35 | my $devid = $dev->id; 36 | next if $all_empty{$devid}; 37 | 38 | my @fids = $dev->fid_list(limit => 1000); 39 | unless (@fids) { 40 | $all_empty{$devid} = 1; 41 | next; 42 | } 43 | $self->parent_ping; 44 | 45 | foreach my $fid (@fids) { 46 | # order is important here: 47 | 48 | # first, add fid to file_to_replicate table. it 49 | # shouldn't matter if the replicator gets to this 50 | # before the subsequent 'forget_about' method, as the 51 | # replicator will treat dead file_on devices as 52 | # non-existent anyway. however, it is important that 53 | # we enqueue it for replication first, before we 54 | # forget about that file_on row, otherwise a failure 55 | # after/during 'forget_about' could leave a stranded 56 | # file on a dead device and we'd never fix it. 57 | # 58 | # and just for extra safety, in case replication happened 59 | # on another machine after 'enqueue_for_replication' but 60 | # before 'forget_about', and that other machine hadn't yet 61 | # re-read the device table to learn that this device 62 | # was dead, we delay the replication for the amount of time 63 | # that the device summary table is valid for (presumably 64 | # the other trackers are running identical software, or 65 | # at least have the same timeout value) 66 | 67 | $fid->enqueue_for_replication(in => DEVICE_SUMMARY_CACHE_TIMEOUT + 1); 68 | $dev->forget_about($fid); 69 | $fid->update_devcount; 70 | } 71 | } 72 | }); 73 | } 74 | 75 | 1; 76 | 77 | # Local Variables: 78 | # mode: perl 79 | # c-basic-indent: 4 80 | # indent-tabs-mode: nil 81 | # End: 82 | -------------------------------------------------------------------------------- /debian/mogilefsd.init: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | ### BEGIN INIT INFO 3 | # Provides: mogilefsd 4 | # Required-Start: $local_fs $remote_fs $network $syslog 5 | # Required-Stop: $local_fs $remote_fs $network $syslog 6 | # Default-Start: 2 3 4 5 7 | # Default-Stop: 0 1 6 8 | # Short-Description: Start/Stop the mogilefsd daemon 9 | # Description: Start/Stop the mogilefsd daemon. 10 | ### END INIT INFO 11 | 12 | # PATH should only include /usr/* if it runs after the mountnfs.sh script 13 | PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin 14 | DAEMON=/usr/bin/mogilefsd 15 | NAME=mogilefsd 16 | DESC=mogilefsd 17 | DEFAULTS=/etc/default/$NAME 18 | PIDFILE=/var/run/$NAME.pid 19 | SCRIPTNAME=/etc/init.d/$NAME 20 | 21 | # Exit if the package is not installed 22 | [ -x "$DAEMON" ] || exit 0 23 | 24 | # Read configuration variable file if it is present 25 | if [ -r $DEFAULTS ] ; then 26 | 27 | . $DEFAULTS 28 | 29 | if [ -z "$MOGILEFSD_RUNASUSER" ]; then 30 | echo "Cannot determine user to run as, even though defaults file ($DEFAULTS) exists." 31 | echo "Please run dpkg-reconfigure $NAME to correct the problem." 32 | exit 0 33 | fi 34 | else 35 | echo "Can't start $NAME. Defaults file ($DEFAULTS) doesn't exist." 36 | echo "Please run dpkg-reconfigure $NAME to correct the problem." 37 | exit 0 38 | fi 39 | 40 | # Load the VERBOSE setting and other rcS variables 41 | . /lib/init/vars.sh 42 | 43 | set -e 44 | 45 | # 46 | # Function that starts the daemon/service 47 | # 48 | do_start() 49 | { 50 | if [ -e $PIDFILE ] 51 | then 52 | 53 | if [ -d /proc/`cat $PIDFILE`/ ] 54 | then 55 | 56 | echo "$NAME already running." 57 | exit 0; 58 | else 59 | rm -f $PIDFILE 60 | fi 61 | 62 | fi 63 | 64 | start-stop-daemon --start --quiet --exec $DAEMON --pidfile $PIDFILE -b -m --name $NAME --chuid $MOGILEFSD_RUNASUSER 65 | } 66 | 67 | # 68 | # Function that stops the daemon/service 69 | # 70 | do_stop() 71 | { 72 | start-stop-daemon --stop --quiet --oknodo --pidfile $PIDFILE --name $NAME --user $MOGILEFSD_RUNASUSER 73 | rm -f $PIDFILE 74 | } 75 | 76 | case "$1" in 77 | start) 78 | echo -n "Starting $DESC: " 79 | do_start 80 | echo "$NAME." 81 | ;; 82 | stop) 83 | echo -n "Stopping $DESC: " 84 | do_stop 85 | echo "$NAME." 86 | ;; 87 | 88 | restart|force-reload) 89 | # 90 | # If the "reload" option is implemented, move the "force-reload" 91 | # option to the "reload" entry above. If not, "force-reload" is 92 | # just the same as "restart". 93 | # 94 | echo -n "Restarting $DESC: " 95 | do_stop 96 | sleep 1 97 | do_start 98 | echo "$NAME." 99 | ;; 100 | *) 101 | #echo "Usage: $SCRIPTNAME {start|stop|restart|reload|force-reload}" >&2 102 | echo "Usage: $SCRIPTNAME {start|stop|restart|force-reload}" >&2 103 | exit 3 104 | ;; 105 | esac 106 | 107 | : 108 | -------------------------------------------------------------------------------- /debian/mogstored.init: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | ### BEGIN INIT INFO 3 | # Provides: mogstored 4 | # Required-Start: $local_fs $remote_fs $network $syslog 5 | # Required-Stop: $local_fs $remote_fs $network $syslog 6 | # Default-Start: 2 3 4 5 7 | # Default-Stop: 0 1 6 8 | # Short-Description: Start/Stop the mogstored daemon 9 | # Description: Start/Stop the mogstored daemon. 10 | ### END INIT INFO 11 | 12 | # PATH should only include /usr/* if it runs after the mountnfs.sh script 13 | PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin 14 | DAEMON=/usr/bin/mogstored 15 | NAME=mogstored 16 | DESC=mogstored 17 | DEFAULTS=/etc/default/$NAME 18 | PIDFILE=/var/run/$NAME.pid 19 | SCRIPTNAME=/etc/init.d/$NAME 20 | 21 | # Exit if the package is not installed 22 | [ -x "$DAEMON" ] || exit 0 23 | 24 | # Read configuration variable file if it is present 25 | if [ -r $DEFAULTS ] ; then 26 | 27 | . $DEFAULTS 28 | 29 | if [ -z "$MOGSTORED_RUNASUSER" ]; then 30 | echo "Cannot determine user to run as, even though defaults file ($DEFAULTS) exists." 31 | echo "Please run dpkg-reconfigure $NAME to correct the problem." 32 | exit 0 33 | fi 34 | else 35 | echo "Can't start $NAME. Defaults file ($DEFAULTS) doesn't exist." 36 | echo "Please run dpkg-reconfigure $NAME to correct the problem." 37 | exit 0 38 | fi 39 | 40 | # Load the VERBOSE setting and other rcS variables 41 | . /lib/init/vars.sh 42 | 43 | set -e 44 | 45 | # 46 | # Function that starts the daemon/service 47 | # 48 | do_start() 49 | { 50 | if [ -e $PIDFILE ] 51 | then 52 | 53 | if [ -d /proc/`cat $PIDFILE`/ ] 54 | then 55 | 56 | echo "$NAME already running." 57 | exit 0; 58 | else 59 | rm -f $PIDFILE 60 | fi 61 | 62 | fi 63 | 64 | start-stop-daemon --start --quiet --exec $DAEMON --pidfile $PIDFILE -b -m --name $NAME --chuid $MOGSTORED_RUNASUSER 65 | } 66 | 67 | # 68 | # Function that stops the daemon/service 69 | # 70 | do_stop() 71 | { 72 | start-stop-daemon --stop --quiet --oknodo --pidfile $PIDFILE --name $NAME --user $MOGSTORED_RUNASUSER 73 | rm -f $PIDFILE 74 | } 75 | 76 | case "$1" in 77 | start) 78 | echo -n "Starting $DESC: " 79 | do_start 80 | echo "$NAME." 81 | ;; 82 | stop) 83 | echo -n "Stopping $DESC: " 84 | do_stop 85 | echo "$NAME." 86 | ;; 87 | 88 | restart|force-reload) 89 | # 90 | # If the "reload" option is implemented, move the "force-reload" 91 | # option to the "reload" entry above. If not, "force-reload" is 92 | # just the same as "restart". 93 | # 94 | echo -n "Restarting $DESC: " 95 | do_stop 96 | sleep 1 97 | do_start 98 | echo "$NAME." 99 | ;; 100 | *) 101 | #echo "Usage: $SCRIPTNAME {start|stop|restart|reload|force-reload}" >&2 102 | echo "Usage: $SCRIPTNAME {start|stop|restart|force-reload}" >&2 103 | exit 3 104 | ;; 105 | esac 106 | 107 | : 108 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/ManageCommand.pm: -------------------------------------------------------------------------------- 1 | # class representing a one-liner management command. all the responses 2 | # to a command should be done through this instance (out, err, ok, etc) 3 | # 4 | # Copyright 2005-2007, Six Apart, Ltd. 5 | # 6 | 7 | package Perlbal::ManageCommand; 8 | use strict; 9 | use warnings; 10 | no warnings qw(deprecated); 11 | 12 | use fields ( 13 | 'base', # the base command name (like "proc") 14 | 'cmd', 15 | 'ok', 16 | 'err', 17 | 'out', 18 | 'orig', 19 | 'argn', 20 | 'ctx', 21 | ); 22 | 23 | sub new { 24 | my ($class, $base, $cmd, $out, $ok, $err, $orig, $ctx) = @_; 25 | my $self = fields::new($class); 26 | 27 | $self->{base} = $base; 28 | $self->{cmd} = $cmd; 29 | $self->{ok} = $ok; 30 | $self->{err} = $err; 31 | $self->{out} = $out; 32 | $self->{orig} = $orig; 33 | $self->{ctx} = $ctx; 34 | $self->{argn} = []; 35 | return $self; 36 | } 37 | 38 | # returns an managecommand object for functions that need one, but 39 | # this does nothing but explode if there any problems. 40 | sub loud_crasher { 41 | use Carp qw(confess); 42 | __PACKAGE__->new(undef, undef, sub {}, sub {}, sub { confess "MC:err: @_" }, "", Perlbal::CommandContext->new); 43 | } 44 | 45 | sub out { my $mc = shift; return @_ ? $mc->{out}->(@_) : $mc->{out}; } 46 | sub ok { my $mc = shift; return $mc->{ok}->(@_); } 47 | 48 | sub err { 49 | my ($mc, $err) = @_; 50 | $err =~ s/\n$//; 51 | $mc->{err}->($err); 52 | } 53 | 54 | sub cmd { my $mc = shift; return $mc->{cmd}; } 55 | sub orig { my $mc = shift; return $mc->{orig}; } 56 | sub end { my $mc = shift; $mc->{out}->("."); 1; } 57 | 58 | sub parse { 59 | my $mc = shift; 60 | my $regexp = shift; 61 | my $usage = shift; 62 | 63 | my @ret = ($mc->{cmd} =~ /$regexp/); 64 | $mc->parse_error($usage) unless @ret; 65 | 66 | my $i = 0; 67 | foreach (@ret) { 68 | $mc->{argn}[$i++] = $_; 69 | } 70 | return $mc; 71 | } 72 | 73 | sub arg { 74 | my $mc = shift; 75 | my $n = shift; # 1-based array, to correspond with $1, $2, $3 76 | return $mc->{argn}[$n - 1]; 77 | } 78 | 79 | sub args { 80 | my $mc = shift; 81 | return @{$mc->{argn}}; 82 | } 83 | 84 | sub parse_error { 85 | my $mc = shift; 86 | my $usage = shift; 87 | $usage .= "\n" if $usage && $usage !~ /\n$/; 88 | die $usage || "Invalid syntax to '$mc->{base}' command\n" 89 | } 90 | 91 | sub no_opts { 92 | my $mc = shift; 93 | die "The '$mc->{base}' command takes no arguments\n" 94 | unless $mc->{cmd} eq $mc->{base}; 95 | return $mc; 96 | } 97 | 98 | 1; 99 | 100 | # Local Variables: 101 | # mode: perl 102 | # c-basic-indent: 4 103 | # indent-tabs-mode: nil 104 | # End: 105 | -------------------------------------------------------------------------------- /lib/MogileFS/ReplicationRequest.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::ReplicationRequest; 2 | use strict; 3 | require Exporter; 4 | our @ISA = qw(Exporter); 5 | our @EXPORT_OK = qw(rr_upgrade ALL_GOOD TOO_GOOD TEMP_NO_ANSWER); 6 | 7 | my $no_answer = bless { temp_fail => 1 }; 8 | sub TEMP_NO_ANSWER () { $no_answer } 9 | my $all_good = bless { all_good => 1 }; 10 | sub ALL_GOOD () { $all_good } 11 | my $too_good = bless { all_good => 1, too_good => 1 }; 12 | sub TOO_GOOD () { $too_good } 13 | 14 | # upgrades the return values from old-style ReplicationPolicy classes 15 | # to MogileFS::ReplicationRequest objects, unless they already are, 16 | # in which case they're passed through unchanged. provides peaceful 17 | # upgrade path for old plugins. 18 | sub rr_upgrade { 19 | my ($rv) = @_; 20 | return $rv if ref $rv; 21 | return TEMP_NO_ANSWER if !defined $rv; 22 | return ALL_GOOD if !$rv; 23 | return MogileFS::ReplicationRequest->replicate_to($rv); 24 | } 25 | 26 | # for ideal replications 27 | sub replicate_to { 28 | my ($class, @devs) = @_; 29 | @devs = map { ref $_ ? $_ : MogileFS::Device->of_devid($_) } @devs; 30 | return bless { 31 | ideal_next => \@devs, 32 | }, $class; 33 | } 34 | 35 | sub new { 36 | my ($class, %opts) = @_; 37 | my $self = bless {}, $class; 38 | $self->{ideal_next} = delete $opts{ideal} || []; 39 | $self->{desperate_next} = delete $opts{desperate} || []; 40 | Carp::croak("unknown args") if %opts; 41 | return $self; 42 | } 43 | 44 | ############################################################################ 45 | 46 | sub is_happy { 47 | my $self = shift; 48 | return $self->{all_good}; 49 | } 50 | 51 | sub too_happy { 52 | my $self = shift; 53 | return $self->{too_good}; 54 | } 55 | 56 | sub temp_fail { 57 | my $self = shift; 58 | return $self->{temp_fail}; 59 | } 60 | 61 | # returns array of MogileFS::Device objs, in preferred order, one of 62 | # which (but not multiple) would satisfy the replication policy 63 | # for its next step. at which point the replication policy needs 64 | # to be asked again what the next step is. 65 | sub copy_to_one_of_ideally { 66 | my $self = shift; 67 | return @{ $self->{ideal_next} || [] }; 68 | } 69 | 70 | # like above, but replication policy isn't happy about these choices, 71 | # so a reevaluation of this replication decision should be made in the 72 | # future, when new disks/hosts might be available. 73 | sub copy_to_one_of_desperate { 74 | my $self = shift; 75 | return @{ $self->{desperate_next} || [] }; 76 | } 77 | 78 | # for test suite.. 79 | sub t_as_string { 80 | my $self = shift; 81 | return "too_good" if $self->{too_good}; 82 | return "all_good" if $self->{all_good}; 83 | return "temp_fail" if $self->{temp_fail}; 84 | my @devs; 85 | if (@devs = $self->copy_to_one_of_ideally) { 86 | return "ideal(" . join(",", sort {$a<=>$b} map { $_->id } @devs) . ")"; 87 | } 88 | if (@devs = $self->copy_to_one_of_desperate) { 89 | return "desperate(" . join(",", sort {$a<=>$b} map { $_->id } @devs) . ")"; 90 | } 91 | die "unknown $self type"; 92 | } 93 | 94 | 1; 95 | 96 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/UploadListener.pm: -------------------------------------------------------------------------------- 1 | ###################################################################### 2 | # Listen for UDP upload status packets 3 | # 4 | # Copyright 2005-2007, Six Apart, Ltd. 5 | 6 | 7 | package Perlbal::UploadListener; 8 | use strict; 9 | use warnings; 10 | no warnings qw(deprecated); 11 | 12 | use base "Perlbal::Socket"; 13 | use fields qw(service hostport); 14 | 15 | # TCPListener 16 | sub new { 17 | my ($class, $hostport, $service) = @_; 18 | 19 | my $sock = 20 | IO::Socket::INET->new( 21 | LocalAddr => $hostport, 22 | Proto => "udp", 23 | ReuseAddr => 1, 24 | Blocking => 0, 25 | ); 26 | 27 | return Perlbal::error("Error creating listening socket: " . ($@ || $!)) 28 | unless $sock; 29 | my $self = fields::new($class); 30 | $self->SUPER::new($sock); 31 | $self->{service} = $service; 32 | $self->{hostport} = $hostport; 33 | $self->watch_read(1); 34 | return $self; 35 | } 36 | 37 | my %status; 38 | my @todelete; 39 | 40 | sub get_status { 41 | my $ses = shift; 42 | return $status{$ses}; 43 | } 44 | 45 | # TCPListener: accepts a new client connection 46 | sub event_read { 47 | my Perlbal::TCPListener $self = shift; 48 | 49 | my $buf; 50 | $self->{sock}->recv($buf, 500); 51 | return unless $buf =~ /^UPLOAD:(\w{5,50}):(\d+):(\d+):(\d+):(\d+)$/; 52 | my ($ses, $done, $total, $starttime, $nowtime) = ($1, $2, $3, $4, $5); 53 | 54 | my $now = time(); 55 | 56 | $status{$ses} = { 57 | done => $done, 58 | total => $total, 59 | starttime => $starttime, 60 | lasttouch => $now, 61 | }; 62 | 63 | # keep a history of touched records, then we'll clean 'em 64 | # after 30 seconds. 65 | push @todelete, [$now, $ses]; 66 | my $too_old = $now - 4; 67 | while (@todelete && $todelete[0][0] < $too_old) { 68 | my $rec = shift @todelete; 69 | my $to_kill = $rec->[1]; 70 | if (my $krec = $status{$to_kill}) { 71 | my $last_touch = $krec->{lasttouch}; 72 | delete $status{$to_kill} if $last_touch < $too_old; 73 | } 74 | } 75 | } 76 | 77 | sub as_string { 78 | my Perlbal::TCPListener $self = shift; 79 | my $ret = $self->SUPER::as_string; 80 | my Perlbal::Service $svc = $self->{service}; 81 | $ret .= ": listening on $self->{hostport} for service '$svc->{name}'"; 82 | return $ret; 83 | } 84 | 85 | sub as_string_html { 86 | my Perlbal::TCPListener $self = shift; 87 | my $ret = $self->SUPER::as_string_html; 88 | my Perlbal::Service $svc = $self->{service}; 89 | $ret .= ": listening on $self->{hostport} for service $svc->{name}"; 90 | return $ret; 91 | } 92 | 93 | sub die_gracefully { 94 | # die off so we stop waiting for new connections 95 | my $self = shift; 96 | $self->close('graceful_death'); 97 | } 98 | 99 | 100 | 1; 101 | 102 | 103 | # Local Variables: 104 | # mode: perl 105 | # c-basic-indent: 4 106 | # indent-tabs-mode: nil 107 | # End: 108 | -------------------------------------------------------------------------------- /MogileFS-Server.spec: -------------------------------------------------------------------------------- 1 | %define perl_vendorlib %(eval "`/usr/bin/perl -V:installvendorlib`"; echo $installvendorlib) 2 | 3 | name: MogileFS-Server 4 | summary: MogileFS-Server - MogileFS Server daemons and utilities. 5 | version: 2.36 6 | release: 2%{?dist} 7 | vendor: Alan Kasindorf 8 | packager: Jonathan Steinert 9 | license: Artistic 10 | group: Applications/CPAN 11 | buildroot: %{_tmppath}/%{name}-%{version}-%(id -u -n) 12 | buildarch: noarch 13 | source: mogilefs-server-%{version}.tar.gz 14 | autoreq: no 15 | requires: MogileFS-Server-mogilefsd = %{version}-%{release} 16 | requires: MogileFS-Server-mogstored = %{version}-%{release} 17 | 18 | # Build requires for mogilefsd 19 | buildrequires: perl(DBI), perl(DBD::mysql), perl(MogileFS::Client), MogileFS-Utils, mysql 20 | # Build requires for mogstored 21 | buildrequires: perl(Perlbal) >= 1.73 22 | 23 | %description 24 | MogileFS Server daemons and utilities. 25 | This is a dummy package which depends on all the others so you can install them all easily. 26 | 27 | %prep 28 | rm -rf "%{buildroot}" 29 | %setup -n mogilefs-server-%{version} 30 | 31 | %build 32 | %{__perl} Makefile.PL INSTALLDIRS="vendor" PREFIX=%{buildroot}%{_prefix} 33 | make all 34 | make test 35 | 36 | %install 37 | make pure_install 38 | 39 | [ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress 40 | 41 | # remove mogdeps and related files 42 | rm -rf %{buildroot}/%{perl_vendorlib}/mogdeps 43 | rm -f %{buildroot}/usr/share/man/man3/mogdeps::* 44 | 45 | # remove special files 46 | find %{buildroot} \( \ 47 | -name "perllocal.pod" \ 48 | -o -name ".packlist" \ 49 | -o -name "*.bs" \ 50 | \) -exec rm -f {} \; 51 | 52 | # no empty directories 53 | find %{buildroot}%{_prefix} \ 54 | -type d -depth -empty \ 55 | -exec rmdir {} \; 56 | 57 | %clean 58 | [ "%{buildroot}" != "/" ] && rm -rf %{buildroot} 59 | 60 | %files 61 | %defattr(-,root,root) 62 | 63 | %package -n MogileFS-Server-mogilefsd 64 | summary: MogileFS-Server-mogilefsd - Mogilefsd and related libraries. 65 | group: Applications/CPAN 66 | autoreq: no 67 | requires: perl(DBI) >= 1.44, perl(DBD::mysql) >= 3 68 | obsoletes: MogileFS-Server-utils <= 2.16 69 | 70 | %description -n MogileFS-Server-mogilefsd 71 | Mogilefsd and related libraries. 72 | 73 | %files -n MogileFS-Server-mogilefsd 74 | %defattr(-,root,root) 75 | %{_prefix}/bin/mogilefsd 76 | %{_prefix}/bin/mogdbsetup 77 | %{perl_vendorlib}/MogileFS/* 78 | %{_prefix}/share/man/man1/mogilefsd.1.gz 79 | %{_prefix}/share/man/man3/MogileFS::*.3pm.gz 80 | 81 | %package -n MogileFS-Server-mogstored 82 | summary: MogileFS-Server-mogstored - Mogstored and related libraries. 83 | group: Applications/CPAN 84 | autoreq: no 85 | requires: perl-Perlbal >= 1.73 86 | obsoletes: MogileFS-Server-utils <= 2.16 87 | 88 | %description -n MogileFS-Server-mogstored 89 | Mogstored and related libraries. 90 | 91 | %files -n MogileFS-Server-mogstored 92 | %defattr(-,root,root) 93 | %{_prefix}/bin/mogstored 94 | %{_prefix}/bin/mogautomount 95 | %{perl_vendorlib}/Mogstored/* 96 | %{_prefix}/share/man/man1/mogstored.1.gz 97 | %{_prefix}/share/man/man1/mogautomount.1.gz 98 | -------------------------------------------------------------------------------- /lib/Mogstored/SideChannelClient.pm: -------------------------------------------------------------------------------- 1 | ### simple package for handling the stream request port 2 | package Mogstored::SideChannelClient; 3 | 4 | use strict; 5 | use base qw{Perlbal::Socket}; 6 | use fields ( 7 | 'count', # how many requests we've serviced 8 | 'read_buf', # unprocessed read buffer 9 | 'mogsvc', # the mogstored Perlbal::Service object 10 | ); 11 | 12 | # needed since we're pretending to be a Perlbal::Socket... never idle out 13 | sub max_idle_time { return 0; } 14 | 15 | sub new { 16 | my Mogstored::SideChannelClient $self = shift; 17 | $self = fields::new($self) unless ref $self; 18 | $self->SUPER::new(@_); 19 | $self->{count} = 0; 20 | $self->{read_buf} = ''; 21 | $self->{mogsvc} = Perlbal->service('mogstored'); 22 | return $self; 23 | } 24 | 25 | sub event_read { 26 | my Mogstored::SideChannelClient $self = shift; 27 | 28 | my $bref = $self->read(1024); 29 | return $self->close unless defined $bref; 30 | $self->{read_buf} .= $$bref; 31 | 32 | my $path = $self->{mogsvc}->{docroot}; 33 | 34 | while ($self->{read_buf} =~ s/^(.+?)\r?\n//) { 35 | my $cmd = $1; 36 | if ($cmd =~ /^size (\S+)$/) { 37 | # increase our count 38 | $self->{count}++; 39 | 40 | # validate uri 41 | my $uri = $1; 42 | if ($uri =~ /\.\./) { 43 | $self->write("ERROR: uri invalid (contains ..)\r\n"); 44 | return; 45 | } 46 | 47 | # now stat the file to get the size and such 48 | Perlbal::AIO::aio_stat("$path$uri", sub { 49 | return if $self->{closed}; 50 | my $size = -e _ ? -s _ : -1; 51 | $self->write("$uri $size\r\n"); 52 | }); 53 | } elsif ($cmd =~ /^watch$/i) { 54 | unless (Mogstored->iostat_available) { 55 | $self->write("ERR iostat unavailable\r\n"); 56 | next; 57 | } 58 | $self->watch_read(0); 59 | Mogstored->iostat_subscribe($self); 60 | } else { 61 | # we don't understand this so pass it on to manage command interface 62 | my @out; 63 | Perlbal::run_manage_command($cmd, sub { push @out, $_[0]; }); 64 | $self->write(join("\r\n", @out) . "\r\n"); 65 | } 66 | } 67 | } 68 | 69 | # stop watching writeability if we've nothing else to 70 | # write to them. else just kick off more writes. 71 | sub event_write { 72 | my $self = shift; 73 | $self->watch_write(0) if $self->write(undef); 74 | } 75 | 76 | # override Danga::Socket's event handlers which die 77 | sub event_err { $_[0]->close; } 78 | sub event_hup { $_[0]->close; } 79 | 80 | # as_string handler 81 | sub as_string { 82 | my Mogstored::SideChannelClient $self = shift; 83 | 84 | my $ret = $self->SUPER::as_string; 85 | $ret .= "; size_requests=$self->{count}"; 86 | 87 | return $ret; 88 | } 89 | 90 | sub close { 91 | my Mogstored::SideChannelClient $self = shift; 92 | Mogstored->iostat_unsubscribe($self); 93 | $self->SUPER::close; 94 | } 95 | 96 | sub die_gracefully { 97 | Mogstored->on_sidechannel_die_gracefully; 98 | } 99 | 100 | 1; 101 | -------------------------------------------------------------------------------- /lib/MogileFS/Connection/Worker.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::Connection::Worker; 2 | # This class maintains a connection to one of the various classes of 3 | # workers. 4 | 5 | use strict; 6 | use Danga::Socket (); 7 | use base qw{Danga::Socket}; 8 | 9 | use fields ( 10 | 'read_buf', 11 | 'job', 12 | 'pid', 13 | 'reqid', 14 | 'last_alive', # unixtime 15 | 'known_state', # hashref of { "$what-$whatid" => $state } 16 | 'wants_todo', # count of how many jobs worker wants. 17 | ); 18 | 19 | sub new { 20 | my MogileFS::Connection::Worker $self = shift; 21 | $self = fields::new($self) unless ref $self; 22 | $self->SUPER::new( @_ ); 23 | 24 | $self->{pid} = 0; 25 | $self->{reqid} = 0; 26 | $self->{wants_todo} = {}; 27 | $self->{job} = undef; 28 | $self->{last_alive} = time(); 29 | $self->{known_state} = {}; 30 | 31 | return $self; 32 | } 33 | 34 | sub note_alive { 35 | my $self = shift; 36 | $self->{last_alive} = time(); 37 | } 38 | 39 | sub watchdog_check { 40 | my MogileFS::Connection::Worker $self = shift; 41 | 42 | my $timeout = $self->worker_class->watchdog_timeout; 43 | my $time_since_last_alive = time() - $self->{last_alive}; 44 | return $time_since_last_alive < $timeout; 45 | } 46 | 47 | sub event_read { 48 | my MogileFS::Connection::Worker $self = shift; 49 | 50 | # if we read data from it, it's not blocked on something else. 51 | $self->note_alive; 52 | 53 | my $bref = $self->read(1024); 54 | return $self->close() unless defined $bref; 55 | $self->{read_buf} .= $$bref; 56 | 57 | while ($self->{read_buf} =~ s/^(.+?)\r?\n//) { 58 | my $line = $1; 59 | if ($self->job eq 'queryworker' && $line !~ /^(?:\:|error|debug)/) { 60 | MogileFS::ProcManager->HandleQueryWorkerResponse($self, $line); 61 | } else { 62 | MogileFS::ProcManager->HandleChildRequest($self, $line); 63 | } 64 | } 65 | } 66 | 67 | sub event_write { 68 | my $self = shift; 69 | my $done = $self->write(undef); 70 | $self->watch_write(0) if $done; 71 | } 72 | 73 | sub job { 74 | my MogileFS::Connection::Worker $self = shift; 75 | return $self->{job} unless @_; 76 | return $self->{job} = shift; 77 | } 78 | 79 | sub wants_todo { 80 | my MogileFS::Connection::Worker $self = shift; 81 | my $type = shift; 82 | return $self->{wants_todo}->{$type}-- unless @_; 83 | return $self->{wants_todo}->{$type} = shift; 84 | } 85 | 86 | sub worker_class { 87 | my MogileFS::Connection::Worker $self = shift; 88 | return MogileFS::ProcManager->job_to_class($self->{job}); 89 | } 90 | 91 | sub pid { 92 | my MogileFS::Connection::Worker $self = shift; 93 | return $self->{pid} unless @_; 94 | return $self->{pid} = shift; 95 | } 96 | 97 | sub event_hup { my $self = shift; $self->close; } 98 | sub event_err { my $self = shift; $self->close; } 99 | 100 | sub close { 101 | # mark us as being dead 102 | my MogileFS::Connection::Worker $self = shift; 103 | MogileFS::ProcManager->NoteDeadWorkerConn($self); 104 | $self->SUPER::close(@_); 105 | } 106 | 107 | 1; 108 | 109 | # Local Variables: 110 | # mode: perl 111 | # c-basic-indent: 4 112 | # indent-tabs-mode: nil 113 | # End: 114 | -------------------------------------------------------------------------------- /lib/Mogstored/FIDStatter.pm: -------------------------------------------------------------------------------- 1 | package Mogstored::FIDStatter; 2 | use strict; 3 | use warnings; 4 | use Carp qw(croak); 5 | 6 | # on_fid => sub { my ($fidid, $size) = @_; ... } 7 | # t_stat => sub { my $fid = shift } 8 | sub new { 9 | my ($class, %opts) = @_; 10 | my $self = bless {}, $class; 11 | foreach (qw(dir from to on_fid t_stat)) { 12 | $self->{$_} = delete $opts{$_}; 13 | } 14 | croak("unknown opts") if %opts; 15 | $self->{on_fid} ||= sub {}; 16 | $self->{t_stat} ||= sub {}; 17 | return $self; 18 | } 19 | 20 | sub run { 21 | my $self = shift; 22 | 23 | # min/max dirs we could possibly care about format: "n/nnn/nnn/" 24 | my $min_dir = dir($self->{from}); 25 | my $max_dir = dir($self->{to}); 26 | 27 | # our start/end fid ranges, zero-padded to 25 or so digits, to be 28 | # string-comparable, avoiding integer math (this might be a 32-bit 29 | # machine, with a 64-bit mogilefsd/clients) 30 | my $min_zpad = zeropad($self->{from}); 31 | my $max_zpad = zeropad($self->{to}); 32 | 33 | my $dir_in_range = sub { 34 | my $dir = shift; # "n/[nnn/[nnnn/]]" 35 | return 0 if max_subdir($dir) lt $min_dir; 36 | return 0 if min_subdir($dir) gt $max_dir; 37 | return 1; 38 | }; 39 | 40 | my $file_in_range = sub { 41 | my $fid = zeropad(shift); 42 | return $fid ge $min_zpad && $fid le $max_zpad; 43 | }; 44 | 45 | foreach_dentry($self->{dir}, qr/^\d$/, sub { 46 | my ($bdir, $dir) = @_; 47 | return unless $dir_in_range->("$bdir/"); 48 | 49 | foreach_dentry($dir, qr/^\d{3}$/, sub { 50 | my ($mdir, $dir) = @_; 51 | return unless $dir_in_range->("$bdir/$mdir/"); 52 | 53 | foreach_dentry($dir, qr/^\d{3}$/, sub { 54 | my ($tdir, $dir) = @_; 55 | return unless $dir_in_range->("$bdir/$mdir/$tdir/"); 56 | 57 | foreach_dentry($dir, qr/^\d+\.fid$/, sub { 58 | my ($file, $fullfile) = @_; 59 | my ($fid) = ($file =~ /^0*(\d+)\.fid$/); 60 | return unless $file_in_range->($fid); 61 | 62 | $self->{t_stat}->($fid); 63 | my $size = (stat($fullfile))[9]; 64 | $self->{on_fid}->($fid, $size) if $size; 65 | }); 66 | }); 67 | }); 68 | }); 69 | } 70 | 71 | sub zeropad { 72 | my $fid = shift; 73 | return "0"x(25-length($fid)) . $fid; 74 | } 75 | 76 | sub foreach_dentry { 77 | my ($dir, $re, $code) = @_; 78 | opendir(my $dh, $dir) or die "Failed to open $dir: $!"; 79 | $code->($_, "$dir/$_") foreach sort grep { /$re/ } readdir($dh); 80 | } 81 | 82 | # returns directory that a fid will be in 83 | # $fid may or may not have leading zeroes. 84 | sub dir { 85 | my $fid = shift; 86 | $fid =~ s!^0*!!; 87 | $fid = "0"x(10-length($fid)) . $fid if length($fid) < 10; 88 | my ($b, $mmm, $ttt) = $fid =~ m{^(\d)(\d{3})(\d{3})}; 89 | return "$b/$mmm/$ttt/"; 90 | } 91 | 92 | sub max_subdir { pad_dir($_[0], "999"); } 93 | sub min_subdir { pad_dir($_[0], "000"); } 94 | 95 | sub pad_dir { 96 | my ($dir, $pad) = @_; 97 | if (length($dir) == 2) { return "$dir$pad/$pad/" } 98 | if (length($dir) == 6) { return "$dir$pad/" } 99 | if (length($dir) == 10) { return $dir } 100 | Carp::confess("how do I pad '$dir' ?"); 101 | } 102 | 103 | 1; 104 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/Vpaths.pm: -------------------------------------------------------------------------------- 1 | ########################################################################### 2 | # plugin to use with selectors to select by path 3 | # 4 | # this will not play well with the Vhosts plugin or any other selector 5 | # behavior plugins. 6 | # 7 | # this has also not been optimized for huge volume sites. 8 | ########################################################################### 9 | 10 | package Perlbal::Plugin::Vpaths; 11 | 12 | use strict; 13 | use warnings; 14 | no warnings qw(deprecated); 15 | 16 | our %Services; # service_name => $svc 17 | 18 | # when "LOAD" directive loads us up 19 | sub load { 20 | my $class = shift; 21 | 22 | Perlbal::register_global_hook('manage_command.vpath', sub { 23 | my $mc = shift->parse(qr/^vpath\s+(?:(\w+)\s+)?(\S+)\s*=\s*(\w+)$/, 24 | "usage: VPATH [] = "); 25 | my ($selname, $regex, $target) = $mc->args; 26 | unless ($selname ||= $mc->{ctx}{last_created}) { 27 | return $mc->err("omitted service name not implied from context"); 28 | } 29 | 30 | my $ss = Perlbal->service($selname); 31 | return $mc->err("Service '$selname' is not a selector service") 32 | unless $ss && $ss->{role} eq "selector"; 33 | 34 | my $cregex = qr/$regex/; 35 | return $mc->err("invalid regular expression: '$regex'") 36 | unless $cregex; 37 | 38 | $ss->{extra_config}->{_vpaths} ||= []; 39 | push @{$ss->{extra_config}->{_vpaths}}, [ $cregex, $target ]; 40 | 41 | return $mc->ok; 42 | }); 43 | return 1; 44 | } 45 | 46 | # unload our global commands, clear our service object 47 | sub unload { 48 | my $class = shift; 49 | 50 | Perlbal::unregister_global_hook('manage_command.vpath'); 51 | unregister($class, $_) foreach (values %Services); 52 | return 1; 53 | } 54 | 55 | # called when we're being added to a service 56 | sub register { 57 | my ($class, $svc) = @_; 58 | unless ($svc && $svc->{role} eq "selector") { 59 | die "You can't load the vpath plugin on a service not of role selector.\n"; 60 | } 61 | 62 | $svc->selector(\&vpath_selector); 63 | $svc->{extra_config}->{_vpaths} = []; 64 | 65 | $Services{"$svc"} = $svc; 66 | return 1; 67 | } 68 | 69 | # called when we're no longer active on a service 70 | sub unregister { 71 | my ($class, $svc) = @_; 72 | $svc->selector(undef); 73 | delete $Services{"$svc"}; 74 | return 1; 75 | } 76 | 77 | # call back from Service via ClientHTTPBase's event_read calling service->select_new_service(Perlbal::ClientHTTPBase) 78 | sub vpath_selector { 79 | my Perlbal::ClientHTTPBase $cb = shift; 80 | 81 | my $req = $cb->{req_headers}; 82 | return $cb->_simple_response(404, "Not Found (no reqheaders)") unless $req; 83 | 84 | my $uri = $req->request_uri; 85 | my $maps = $cb->{service}{extra_config}{_vpaths} ||= {}; 86 | 87 | # iterate down the list of paths, find any matches 88 | foreach my $row (@$maps) { 89 | next unless $uri =~ /$row->[0]/; 90 | 91 | my $svc_name = $row->[1]; 92 | my $svc = $svc_name ? Perlbal->service($svc_name) : undef; 93 | unless ($svc) { 94 | $cb->_simple_response(404, "Not Found ($svc_name not a defined service)"); 95 | return 1; 96 | } 97 | 98 | $svc->adopt_base_client($cb); 99 | return 1; 100 | } 101 | 102 | return 0; 103 | } 104 | 105 | 1; 106 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/LazyCDN.pm: -------------------------------------------------------------------------------- 1 | package Perlbal::Plugin::LazyCDN; 2 | 3 | use IO::Socket::INET; 4 | use Perlbal; 5 | use Perlbal::ClientHTTPBase; 6 | use strict; 7 | use warnings; 8 | 9 | sub load { 10 | # add up custom configuration options that people are allowed to set 11 | Perlbal::Service::add_tunable( 12 | # allow the following: 13 | # SET myservice.fallback_service = proxy 14 | fallback_service => { 15 | des => "Service name to fall back to when a static get or concat get requests something newer than on disk.", 16 | check_role => "web_server", 17 | } 18 | ); 19 | 20 | Perlbal::Service::add_tunable( 21 | # allow the following: 22 | # SET myservice.fallback_udp_ping_addr = 5 23 | fallback_udp_ping_addr => { 24 | des => "Address and port to send UDP packets containing URL requests .", 25 | check_role => "web_server", 26 | check_type => ["regexp", qr/^\d+\.\d+\.\d+\.\d+:\d+$/, "Expecting IP:port of form a.b.c.d:port."], 27 | } 28 | ); 29 | return 1; 30 | } 31 | 32 | # remove the various things we've hooked into, this is required as a way of 33 | # being good to the system... 34 | sub unload { 35 | Perlbal::Service::remove_tunable('fallback_service'); 36 | Perlbal::Service::remove_tunable('fallback_udp_ping_addr'); 37 | return 1; 38 | } 39 | 40 | # called when we're being added to a service 41 | sub register { 42 | my ($class, $svc) = @_; 43 | 44 | my $socket; 45 | 46 | my $hook = sub { 47 | my Perlbal::ClientHTTPBase $client = shift; 48 | my $last_modified = shift; # unix timestamp for last modified of the concatenated files 49 | 50 | my $fallback_service_name = $client->{service}->{extra_config}->{fallback_service}; 51 | return unless $fallback_service_name; 52 | 53 | my $fallback_service = Perlbal->service($fallback_service_name); 54 | return unless $fallback_service; 55 | 56 | my $req_hd = $client->{req_headers}; 57 | 58 | my $uri = $req_hd->request_uri; 59 | 60 | my ($v) = $uri =~ m/\bv=(\d+)\b/; 61 | 62 | if (defined $last_modified) { 63 | return unless $v; 64 | return 0 unless $v > $last_modified; 65 | } 66 | 67 | if (my $fallback_ping_addr = $client->{service}->{extra_config}->{fallback_udp_ping_addr}) { 68 | $socket ||= _ping_socket($fallback_ping_addr); 69 | $socket->write($uri); 70 | } 71 | 72 | $fallback_service->adopt_base_client( $client ); 73 | 74 | return 1; 75 | }; 76 | 77 | $svc->register_hook('LazyCDN', 'static_get_poststat_pre_send', $hook); 78 | $svc->register_hook('LazyCDN', 'concat_get_poststat_pre_send', $hook); 79 | 80 | $svc->register_hook('LazyCDN', 'static_get_poststat_file_missing', $hook); 81 | $svc->register_hook('LazyCDN', 'concat_get_poststat_file_missing', $hook); 82 | 83 | return 1; 84 | } 85 | 86 | # called when we're no longer active on a service 87 | sub unregister { 88 | my ($class, $svc) = @_; 89 | return 1; 90 | } 91 | 92 | sub _ping_socket { 93 | my $hostspec = shift; 94 | my $socket = IO::Socket::INET->new( 95 | PeerAddr => $hostspec, 96 | Proto => 'udp', 97 | Broadcast => 1, 98 | ReuseAddr => 1) 99 | or warn "Can't bind udp ping socket: $!\n"; 100 | return $socket; 101 | } 102 | 103 | 1; 104 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | CHANGES 2 | doc/fsck-notes.txt 3 | doc/memcache-support.txt 4 | doc/pluggable-replication-policies.txt 5 | doc/testing.txt 6 | lib/mogdeps/Danga/Socket.pm 7 | lib/mogdeps/Net/Netmask.pm 8 | lib/mogdeps/Perlbal.pm 9 | lib/mogdeps/Perlbal/AIO.pm 10 | lib/mogdeps/Perlbal/BackendHTTP.pm 11 | lib/mogdeps/Perlbal/Cache.pm 12 | lib/mogdeps/Perlbal/ChunkedUploadState.pm 13 | lib/mogdeps/Perlbal/ClientHTTP.pm 14 | lib/mogdeps/Perlbal/ClientHTTPBase.pm 15 | lib/mogdeps/Perlbal/ClientManage.pm 16 | lib/mogdeps/Perlbal/ClientProxy.pm 17 | lib/mogdeps/Perlbal/CommandContext.pm 18 | lib/mogdeps/Perlbal/HTTPHeaders.pm 19 | lib/mogdeps/Perlbal/ManageCommand.pm 20 | lib/mogdeps/Perlbal/Plugin/AccessControl.pm 21 | lib/mogdeps/Perlbal/Plugin/AutoRemoveLeadingDir.pm 22 | lib/mogdeps/Perlbal/Plugin/Highpri.pm 23 | lib/mogdeps/Perlbal/Plugin/NotModified.pm 24 | lib/mogdeps/Perlbal/Plugin/Queues.pm 25 | lib/mogdeps/Perlbal/Plugin/Stats.pm 26 | lib/mogdeps/Perlbal/Plugin/Vhosts.pm 27 | lib/mogdeps/Perlbal/Plugin/AtomInject.pm 28 | lib/mogdeps/Perlbal/Plugin/AtomStream.pm 29 | lib/mogdeps/Perlbal/Plugin/Cgilike.pm 30 | lib/mogdeps/Perlbal/Plugin/EchoService.pm 31 | lib/mogdeps/Perlbal/Plugin/Include.pm 32 | lib/mogdeps/Perlbal/Plugin/LazyCDN.pm 33 | lib/mogdeps/Perlbal/Plugin/MaxContentLength.pm 34 | lib/mogdeps/Perlbal/Plugin/Palimg.pm 35 | lib/mogdeps/Perlbal/Plugin/Redirect.pm 36 | lib/mogdeps/Perlbal/Plugin/Vpaths.pm 37 | lib/mogdeps/Perlbal/Pool.pm 38 | lib/mogdeps/Perlbal/ReproxyManager.pm 39 | lib/mogdeps/Perlbal/Service.pm 40 | lib/mogdeps/Perlbal/Socket.pm 41 | lib/mogdeps/Perlbal/TCPListener.pm 42 | lib/mogdeps/Perlbal/Test.pm 43 | lib/mogdeps/Perlbal/Test/WebClient.pm 44 | lib/mogdeps/Perlbal/Test/WebServer.pm 45 | lib/mogdeps/Perlbal/UploadListener.pm 46 | lib/mogdeps/Perlbal/Util.pm 47 | lib/mogdeps/Perlbal/SocketSSL.pm 48 | lib/mogdeps/Sys/Syscall.pm 49 | lib/MogileFS/Class.pm 50 | lib/MogileFS/Config.pm 51 | lib/MogileFS/Connection/Client.pm 52 | lib/MogileFS/Connection/Mogstored.pm 53 | lib/MogileFS/Connection/Worker.pm 54 | lib/MogileFS/DevFID.pm 55 | lib/MogileFS/Device.pm 56 | lib/MogileFS/DeviceState.pm 57 | lib/MogileFS/Domain.pm 58 | lib/MogileFS/Exception.pm 59 | lib/MogileFS/FID.pm 60 | lib/MogileFS/Host.pm 61 | lib/MogileFS/HTTPFile.pm 62 | lib/MogileFS/IOStatWatcher.pm 63 | lib/MogileFS/Overview.pm 64 | lib/MogileFS/ProcManager.pm 65 | lib/MogileFS/ReplicationPolicy.pm 66 | lib/MogileFS/ReplicationPolicy/MultipleHosts.pm 67 | lib/MogileFS/ReplicationPolicy/Union.pm 68 | lib/MogileFS/ReplicationRequest.pm 69 | lib/MogileFS/Server.pm 70 | lib/MogileFS/Store.pm 71 | lib/MogileFS/Store/MySQL.pm 72 | lib/MogileFS/Store/Postgres.pm 73 | lib/MogileFS/Store/SQLite.pm 74 | lib/MogileFS/Sys.pm 75 | lib/MogileFS/Test.pm 76 | lib/MogileFS/Util.pm 77 | lib/MogileFS/Worker.pm 78 | lib/MogileFS/Worker/Delete.pm 79 | lib/MogileFS/Worker/Fsck.pm 80 | lib/MogileFS/Worker/Monitor.pm 81 | lib/MogileFS/Worker/Query.pm 82 | lib/MogileFS/Worker/Reaper.pm 83 | lib/MogileFS/Worker/Replicate.pm 84 | lib/MogileFS/Worker/JobMaster.pm 85 | lib/Mogstored/ChildProcess.pm 86 | lib/Mogstored/ChildProcess/DiskUsage.pm 87 | lib/Mogstored/ChildProcess/IOStat.pm 88 | lib/Mogstored/FIDStatter.pm 89 | lib/Mogstored/HTTPServer.pm 90 | lib/Mogstored/HTTPServer/Apache.pm 91 | lib/Mogstored/HTTPServer/Lighttpd.pm 92 | lib/Mogstored/HTTPServer/Perlbal.pm 93 | lib/Mogstored/HTTPServer/None.pm 94 | lib/Mogstored/SideChannelClient.pm 95 | lib/Mogstored/SideChannelListener.pm 96 | Makefile.PL 97 | MANIFEST 98 | mogautomount 99 | mogdbsetup 100 | mogilefsd 101 | mogstored 102 | t/00-startup.t 103 | t/10-weighting.t 104 | t/20-filepaths.t 105 | t/domains-classes.t 106 | t/fid-stat.t 107 | t/hosts-devices.t 108 | t/mogstored-shutdown.t 109 | t/multiple-hosts-replpol.t 110 | t/replpolicy-parsing.t 111 | t/replpolicy.t 112 | t/store.t 113 | t/util.t 114 | TODO 115 | TESTING 116 | -------------------------------------------------------------------------------- /t/10-weighting.t: -------------------------------------------------------------------------------- 1 | # -*-perl-*- 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use FindBin qw($Bin); 7 | use Time::HiRes qw(sleep); 8 | 9 | use MogileFS::Server; 10 | 11 | BEGIN { 12 | $ENV{TESTING} = 1; 13 | $ENV{T_FAKE_IO_DEV1} = 95; # Simulating high device load (should get fewer requests). 14 | $ENV{T_FAKE_IO_DEV2} = 5; # Simulating low device load (should get more requests). 15 | } 16 | 17 | use MogileFS::Test; 18 | find_mogclient_or_skip(); 19 | 20 | # create temp mysql db, 21 | # use mogadm to init it, 22 | # mogstored on temp dir, 23 | # register mogstored temp dir, 24 | # mogilefsd startup, 25 | # add file, 26 | # etc 27 | 28 | my $sto = eval { temp_store(); }; 29 | if ($sto) { 30 | plan tests => 16; 31 | } else { 32 | plan skip_all => "Can't create temporary test database: $@"; 33 | exit 0; 34 | } 35 | 36 | my $dbh = $sto->dbh; 37 | my $rv; 38 | 39 | use File::Temp; 40 | my %mogroot; 41 | $mogroot{1} = File::Temp::tempdir( CLEANUP => 1 ); 42 | $mogroot{2} = File::Temp::tempdir( CLEANUP => 1 ); 43 | my $dev2host = { 1 => 1, 2 => 2, }; 44 | foreach (sort { $a <=> $b } keys %$dev2host) { 45 | my $root = $mogroot{$dev2host->{$_}}; 46 | mkdir("$root/dev$_") or die "Failed to create dev$_ dir: $!"; 47 | } 48 | 49 | my $ms1 = create_mogstored("127.0.1.1", $mogroot{1}); 50 | ok($ms1, "got mogstored1"); 51 | my $ms2 = create_mogstored("127.0.1.2", $mogroot{2}); 52 | ok($ms1, "got mogstored2"); 53 | 54 | while (! -e "$mogroot{1}/dev1/usage" && 55 | ! -e "$mogroot{2}/dev2/usage") { 56 | print "Waiting on usage...\n"; 57 | sleep(.25); 58 | } 59 | 60 | my $tmptrack = create_temp_tracker($sto); 61 | ok($tmptrack); 62 | 63 | my $mogc = MogileFS::Client->new( 64 | domain => "testdom", 65 | hosts => [ "127.0.0.1:7001" ], 66 | ); 67 | my $be = $mogc->{backend}; # gross, reaching inside of MogileFS::Client 68 | 69 | # test some basic commands to backend 70 | ok($tmptrack->mogadm("domain", "add", "testdom"), "created test domain"); 71 | ok($tmptrack->mogadm("class", "add", "testdom", "2copies", "--mindevcount=2"), "created 2copies class in testdom"); 72 | 73 | ok($tmptrack->mogadm("host", "add", "hostA", "--ip=127.0.1.1", "--status=alive"), "created hostA"); 74 | ok($tmptrack->mogadm("host", "add", "hostB", "--ip=127.0.1.2", "--status=alive"), "created hostB"); 75 | 76 | ok($tmptrack->mogadm("device", "add", "hostA", 1), "created dev1 on hostA"); 77 | ok($tmptrack->mogadm("device", "add", "hostB", 2), "created dev2 on hostB"); 78 | 79 | # wait for monitor 80 | { 81 | my $was = $be->{timeout}; # can't use local on phash :( 82 | $be->{timeout} = 10; 83 | ok($be->do_request("do_monitor_round", {}), "waited for monitor") 84 | or die "Failed to wait for monitor"; 85 | $be->{timeout} = $was; 86 | } 87 | 88 | # create one sample file 89 | my $fh = $mogc->new_file("file1", "2copies"); 90 | ok($fh, "got filehandle"); 91 | unless ($fh) { 92 | die "Error: " . $mogc->errstr; 93 | } 94 | 95 | my $data = "My test file.\n" x 1024; 96 | print $fh $data; 97 | ok(close($fh), "closed file"); 98 | 99 | # wait for it to replicate 100 | my $tries = 1; 101 | my @urls; 102 | while ($tries++ < 40 && (@urls = $mogc->get_paths("file1")) < 2) { 103 | sleep .25; 104 | } 105 | is(scalar @urls, 2, "replicated to 2 paths"); 106 | my $to_repl_rows = $dbh->selectrow_array("SELECT COUNT(*) FROM file_to_replicate"); 107 | is($to_repl_rows, 0, "no more files to replicate"); 108 | 109 | my %stats; 110 | for (1..100) { 111 | @urls = $mogc->get_paths("file1"); 112 | my ($devno) = $urls[0] =~ m!/dev(\d+)/!; 113 | $stats{$devno}++; 114 | } 115 | 116 | ok($stats{1} < 15, "Device 1 should get roughly 5% of traffic, got: $stats{1}"); 117 | ok($stats{2} > 80, "Device 2 should get roughly 95% of traffic, got: $stats{2}"); 118 | 119 | -------------------------------------------------------------------------------- /t/fid-stat.t: -------------------------------------------------------------------------------- 1 | # -*-perl-*- 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use FindBin qw($Bin); 7 | 8 | use Mogstored::FIDStatter; 9 | use File::Temp qw(tempdir); 10 | 11 | plan tests => 11; 12 | 13 | my $td = tempdir(CLEANUP => 1); 14 | ok($td, "got tempdir"); 15 | ok(-d $td, "tempdir is writable"); 16 | 17 | my $n_stats; 18 | my $on_fid; 19 | 20 | my $fs = Mogstored::FIDStatter->new( 21 | dir => $td, 22 | from => 500, 23 | to => 1499, 24 | t_stat => sub { $n_stats++ }, 25 | on_fid => sub { $on_fid->(@_); }, 26 | ); 27 | ok($fs, "made statter"); 28 | 29 | # empty directory, no stats 30 | { 31 | $n_stats = 0; 32 | my @list; 33 | $on_fid = sub { 34 | push @list, [@_], 35 | }; 36 | $fs->run; 37 | is($n_stats, 0, "no stats on empty directory"); 38 | is(scalar @list, 0, "no contents on empty directory"); 39 | } 40 | 41 | # make a normal (packed) directory structure 42 | { 43 | for (my $n = 500; $n < 1500; $n += 2) { 44 | make_file($n, ($n%50) + 1); 45 | } 46 | 47 | $n_stats = 0; 48 | my @list; 49 | $on_fid = sub { 50 | push @list, [@_], 51 | }; 52 | $fs->run; 53 | is($n_stats, 500, "500 stats"); 54 | is(scalar @list, 500, "500 fids found"); 55 | } 56 | 57 | # make a sparse directory structure, with huge (64-bit numbers) 58 | { 59 | $n_stats = 0; 60 | my @list; 61 | make_file("52048709162819278", 50); 62 | make_file("52048709163819278", 50); 63 | make_file("52048809163819278", 50); 64 | make_file("52048819163819278", 50); 65 | $fs = Mogstored::FIDStatter->new( 66 | dir => $td, 67 | from => "52048709162819278", 68 | to => "52048819163819278", 69 | t_stat => sub { $n_stats++ }, 70 | on_fid => sub { 71 | push @list, [@_]; 72 | }, 73 | ); 74 | $fs->run; 75 | is(scalar @list, 4, "found 4 files"); 76 | is($n_stats, 4, "and statted 4 files"); 77 | } 78 | 79 | # trick jonathan... 80 | { 81 | $n_stats = 0; 82 | my @list; 83 | make_file("3001002456", 50); 84 | make_file("3001002457", 50); 85 | make_file("30010023383333458", 50); 86 | make_file("3001002459", 50); 87 | $fs = Mogstored::FIDStatter->new( 88 | dir => $td, 89 | from => "3001002456", 90 | to => "3001002459", 91 | t_stat => sub { $n_stats++ }, 92 | on_fid => sub { 93 | push @list, [@_]; 94 | }, 95 | ); 96 | $fs->run(); 97 | is(scalar @list, 3, "found 3 files"); 98 | is($n_stats, 3, "and statted 3 files"); 99 | } 100 | 101 | sub make_file { 102 | my ($fid, $len) = @_; 103 | my $pad = $fid; 104 | if (length($pad) < 10) { 105 | $pad = "0"x(10-length($pad)) . $pad; 106 | } 107 | my ($b, $mmm, $ttt, $hto) = ($pad =~ m{(\d)(\d{3})(\d{3})(\d{3})}); 108 | my $fh; 109 | unless (open($fh, ">$td/$b/$mmm/$ttt/$pad.fid")) { 110 | if ($!{ENOENT}) { 111 | mkdir "$td/$b"; 112 | mkdir "$td/$b/$mmm"; 113 | mkdir "$td/$b/$mmm/$ttt"; 114 | } 115 | open($fh, ">$td/$b/$mmm/$ttt/$pad.fid") or die 116 | "Error writing file: $td/$b/$mmm/$ttt/$pad.fid: $!\n"; 117 | } 118 | print $fh "x" x (($len % 50) + 1); 119 | close($fh) or die; 120 | } 121 | 122 | 123 | 124 | -------------------------------------------------------------------------------- /mogautomount: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use Getopt::Long; 5 | 6 | # Rename binary in process list to make init scripts saner 7 | $0 = $_ = $0; 8 | 9 | my ($help, $verbose, $chmod_mountpoints); 10 | usage(0) unless GetOptions( 11 | 'help' => \$help, 12 | 'verbose' => \$verbose, 13 | 'chmod-mountpoints' => \$chmod_mountpoints, 14 | ); 15 | usage(0) if @ARGV; 16 | usage(2) if $help; 17 | 18 | sub usage { 19 | my $verbosity = shift; 20 | require Pod::Usage; 21 | Pod::Usage::pod2usage({ 22 | -exitval => 1, 23 | -verbose => $verbosity, 24 | }); 25 | } 26 | 27 | my $base = "/var/mogdata"; 28 | my @bdevs = `/sbin/blkid -c /dev/null`; 29 | die "Failed to run /sbin/blkid to get available block devices." if $?; 30 | 31 | my %mounted; # dev -> 1 32 | open (M, "/proc/mounts") or die "Failed to open /proc/mounts for reading: $!\n"; 33 | while () { 34 | m!^(\S+) /var/mogdata/dev(\d+)! or next; 35 | my $devid = $2; 36 | $mounted{$1} = 1; 37 | if ($verbose) { 38 | warn "Mogile device $devid, $1, is already mounted.\n"; 39 | } 40 | } 41 | 42 | my $bad_count = 0; 43 | my $good_count = 0; 44 | 45 | foreach my $bdev (@bdevs) { 46 | next unless $bdev =~ /^(.+?):.*LABEL="MogileDev(\d+)"/; 47 | my ($dev, $devid) = ($1, $2); 48 | unless (-d "$base") { mkdir $base or die "Failed to mkdir $base: $!"; } 49 | my $mnt = "$base/dev$devid"; 50 | unless (-d $mnt) { mkdir $mnt or die "Failed to mkdir $mnt: $!"; } 51 | next if $mounted{$dev}; 52 | 53 | if ($chmod_mountpoints and ((stat($mnt))[2] & 0777) != 0) { 54 | warn "Mountpoint on parent filesystem is writable, fixing.\n" if $verbose; 55 | chmod 0, $mnt 56 | or die "Unable to set mogile device mountpoint '$mnt' mode to 0 (no access)"; 57 | } 58 | 59 | if (system("mount", '-o', 'noatime', $dev, $mnt)) { 60 | warn "Failed to mount $dev at $mnt.\n"; 61 | $bad_count++; 62 | } else { 63 | warn "Mounted device $devid at $mnt.\n" if $verbose; 64 | $good_count++; 65 | } 66 | } 67 | 68 | exit 0 if ! $bad_count; 69 | exit 1 if $good_count; 70 | exit 2; 71 | 72 | __END__ 73 | 74 | =head1 NAME 75 | 76 | mogautomount - automatically discover and mount MogileFS disks 77 | 78 | =head1 SYNOPSIS 79 | 80 | mogautomount [--verbose | -v] 81 | mogautomount [--help | -h] 82 | 83 | =head1 DESCRIPTION 84 | 85 | Mounts all unmounted filesystems with labels of form "MogileDev" at 86 | /var/mogdata/dev, creating the needed directories as well. 87 | 88 | You can do this at runtime without restarting mogstored, assuming you 89 | can add new block devices at runtime via your SCSI/SATA/etc controller. 90 | 91 | =head1 OPTIONS 92 | 93 | =over 94 | 95 | =item --help | -h 96 | 97 | this help 98 | 99 | =item --verbose | -verbose 100 | 101 | be verbose 102 | 103 | =item --chmod-mountpoints 104 | 105 | If a mogile device isn't mounted yet, check to make sure the underlying filesystem has the directory set 106 | to be not readable or writable at all (chmod 0). This could help prevent mogstored from accidentally writing 107 | to the underlying filesystem. 108 | 109 | =back 110 | 111 | =head1 RETURN CODE 112 | 113 | 0 on success or inaction because no action needed to happen. 114 | 115 | 1 on partial failure (some mounts succeed). 116 | 117 | 2 on total failure (things had to be done, but nothing was). 118 | 119 | =head1 AUTHOR 120 | 121 | Brad Fitzpatrick, Ebrad@danga.comE 122 | 123 | =head1 WARRANTY, BUGS, DISCLAIMER 124 | 125 | This tool mounts disks, and disks hold data, so naturally you should 126 | be afraid. Real the source code to see what it does. This tool comes 127 | with no warranty of any kind. You're response for its use or misuse. 128 | 129 | =head1 COPYRIGHT & LICENSE 130 | 131 | This tool is Copyright 2006, Six Apart, Ltd. 132 | You're free to redistribute it under the same terms as perl itself. 133 | 134 | =end 135 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/Redirect.pm: -------------------------------------------------------------------------------- 1 | package Perlbal::Plugin::Redirect; 2 | use strict; 3 | use warnings; 4 | 5 | sub handle_request { 6 | my ($svc, $pb) = @_; 7 | 8 | my $mappings = $svc->{extra_config}{_redirect_host}; 9 | my $req_header = $pb->{req_headers}; 10 | 11 | # returns 1 if done with client, 0 if no action taken 12 | my $map_using = sub { 13 | my ($match_on) = @_; 14 | 15 | my $target_host = $mappings->{$match_on}; 16 | 17 | return 0 unless $target_host; 18 | 19 | my $path = $req_header->request_uri; 20 | 21 | my $res_header = Perlbal::HTTPHeaders->new_response(301); 22 | $res_header->header('Location' => "http://$target_host$path"); 23 | $res_header->header('Content-Length' => 0); 24 | # For some reason a follow-up request gets a "400 Bad request" response, 25 | # so until someone has time to figure out why, just punt and disable 26 | # keep-alives after this request. 27 | $res_header->header('Connection' => 'close'); 28 | $pb->write($res_header->to_string_ref()); 29 | 30 | return 1; 31 | }; 32 | 33 | # The following is lifted wholesale from the vhosts plugin. 34 | # FIXME: Factor it out to a utility function, I guess? 35 | # 36 | # foo.site.com should match: 37 | # foo.site.com 38 | # *.foo.site.com 39 | # *.site.com 40 | # *.com 41 | # * 42 | 43 | my $vhost = lc($req_header->header("Host")); 44 | 45 | # if no vhost, just try the * mapping 46 | return $map_using->("*") unless $vhost; 47 | 48 | # Strip off the :portnumber, if any 49 | $vhost =~ s/:\d+$//; 50 | 51 | # try the literal mapping 52 | return 1 if $map_using->($vhost); 53 | 54 | # and now try wildcard mappings, removing one part of the domain 55 | # at a time until we find something, or end up at "*" 56 | 57 | # first wildcard, prepending the "*." 58 | my $wild = "*.$vhost"; 59 | return 1 if $map_using->($wild); 60 | 61 | # now peel away subdomains 62 | while ($wild =~ s/^\*\.[\w\-\_]+/*/) { 63 | return 1 if $map_using->($wild); 64 | } 65 | 66 | # last option: use the "*" wildcard 67 | return $map_using->("*"); 68 | } 69 | 70 | sub register { 71 | my ($class, $svc) = @_; 72 | 73 | $svc->register_hook('Redirect', 'start_http_request', sub { handle_request($svc, $_[0]); }); 74 | } 75 | 76 | sub unregister { 77 | my ($class, $svc) = @_; 78 | $svc->unregister_hooks('Redirect'); 79 | } 80 | 81 | sub handle_redirect_command { 82 | my $mc = shift->parse(qr/^redirect\s+host\s+(\S+)\s+(\S+)$/, "usage: REDIRECT HOST "); 83 | my ($match_host, $target_host) = $mc->args; 84 | 85 | my $svcname; 86 | unless ($svcname ||= $mc->{ctx}{last_created}) { 87 | return $mc->err("No service name in context from CREATE SERVICE or USE "); 88 | } 89 | 90 | my $svc = Perlbal->service($svcname); 91 | return $mc->err("Non-existent service '$svcname'") unless $svc; 92 | 93 | $svc->{extra_config}{_redirect_host} ||= {}; 94 | $svc->{extra_config}{_redirect_host}{lc($match_host)} = lc($target_host); 95 | 96 | return 1; 97 | } 98 | 99 | # called when we are loaded 100 | sub load { 101 | Perlbal::register_global_hook('manage_command.redirect', \&handle_redirect_command); 102 | 103 | return 1; 104 | } 105 | 106 | # called for a global unload 107 | sub unload { 108 | return 1; 109 | } 110 | 111 | 1; 112 | 113 | =head1 NAME 114 | 115 | Perlbal::Plugin::Redirect - Plugin to do redirecting in Perlbal land 116 | 117 | =head1 SYNOPSIS 118 | 119 | LOAD redirect 120 | 121 | CREATE SERVICE redirector 122 | SET role = web_server 123 | SET plugins = redirect 124 | REDIRECT HOST example.com www.example.net 125 | ENABLE redirector 126 | 127 | =head1 LIMITATIONS 128 | 129 | Right now this can only redirect at the hostname level. Also, it just 130 | assumes you want an http: URL. 131 | -------------------------------------------------------------------------------- /t/multiple-hosts-replpol.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use FindBin qw($Bin); 7 | 8 | use MogileFS::Server; 9 | use MogileFS::Util qw(error_code); 10 | use MogileFS::ReplicationPolicy::MultipleHosts; 11 | use MogileFS::Test; 12 | 13 | plan tests => 13; 14 | 15 | # already good. 16 | is(rr("min=2 h1[d1=X d2=_] h2[d3=X d4=_]"), 17 | "all_good", "all good"); 18 | 19 | # need to get it onto host2... 20 | is(rr("min=2 h1[d1=X d2=_] h2[d3=_ d4=_]"), 21 | "ideal(3,4)", "need host2"); 22 | 23 | # still needs to be on host2, even though 2 copies on host1 24 | is(rr("min=2 h1[d1=X d2=X] h2[d3=_ d4=_]"), 25 | "ideal(3,4)", "need host2, even though 2 on host1"); 26 | 27 | # anywhere will do. (can happen on, say, rebalance) 28 | is(rr("min=2 h1[d1=_ d2=_] h2[d3=_ d4=_]"), 29 | "ideal(1,2,3,4)", "anywhere"); 30 | 31 | # should desperately try d2, since host2 is down 32 | is(rr("min=2 h1[d1=X d2=_] h2=down[d3=_ d4=_]"), 33 | "desperate(2)"); 34 | 35 | # should try host3, since host2 is down 36 | is(rr("min=2 h1[d1=X d2=_] h2=down[d3=_ d4=_] h3[d5=_ d6=_]"), 37 | "ideal(5,6)"); 38 | 39 | # need a copy on a non-dead disk on host1 40 | is(rr("min=2 h1[d1=_ d2=X,dead] h2=alive[d3=X d4=_]"), 41 | "ideal(1)"); 42 | 43 | # this is an ideal move, since we only have 2 unique hosts: 44 | is(rr("min=3 h1[d1=_ d2=X] h2[d3=X d4=_]"), 45 | "ideal(1,4)"); 46 | 47 | # ... but if we have a 3rd host, it's gotta be there 48 | is(rr("min=3 h1[d1=_ d2=X] h2[d3=X d4=_] h3[d5=_]"), 49 | "ideal(5)"); 50 | 51 | # ... unless that host is down, in which case it's back to 1/4, 52 | # but desperately 53 | is(rr("min=3 h1[d1=_ d2=X] h2[d3=X d4=_] h3=down[d5=_]"), 54 | "desperate(1,4)"); 55 | 56 | # too good, uniq hosts > min 57 | is(rr("min=2 h1[d1=X d2=_] h2[d3=X d4=_] h3[d5=X]"), 58 | "too_good"); 59 | 60 | # too good, but but with uniq hosts == min 61 | is(rr("min=2 h1[d1=X d2=X] h2[d3=X d4=_]"), 62 | "too_good"); 63 | 64 | # be happy with 3 copies, even though two are on same host (that's our max unique hosts) 65 | is(rr("min=3 h1[d1=_ d2=X] h2[d3=X d4=X]"), 66 | "all_good"); 67 | 68 | sub rr { 69 | my ($state) = @_; 70 | my $ostate = $state; # original 71 | 72 | MogileFS::Host->t_wipe_singletons; 73 | MogileFS::Device->t_wipe_singletons; 74 | MogileFS::Config->set_config_no_broadcast("min_free_space", 100); 75 | 76 | my $min = 2; 77 | if ($state =~ s/^\bmin=(\d+)\b//) { 78 | $min = $1; 79 | } 80 | 81 | my $hosts = {}; 82 | my $devs = {}; 83 | my $on_devs = []; 84 | 85 | my $parse_error = sub { 86 | die "Can't parse:\n $ostate\n" 87 | }; 88 | while ($state =~ s/\bh(\d+)(?:=(.+?))?\[(.+?)\]//) { 89 | my ($n, $opts, $devstr) = ($1, $2, $3); 90 | $opts ||= ""; 91 | die "dup host $n" if $hosts->{$n}; 92 | 93 | my $h = $hosts->{$n} = MogileFS::Host->of_hostid($n); 94 | $h->t_init($opts || "alive"); 95 | 96 | foreach my $ddecl (split(/\s+/, $devstr)) { 97 | $ddecl =~ /^d(\d+)=([_X])(?:,(\w+))?$/ 98 | or $parse_error->(); 99 | my ($dn, $on_not, $status) = ($1, $2, $3); 100 | die "dup device $dn" if $devs->{$dn}; 101 | my $d = $devs->{$dn} = MogileFS::Device->of_devid($dn); 102 | $status ||= "alive"; 103 | $d->t_init($h->id, $status); 104 | if ($on_not eq "X" && $d->dstate->should_have_files) { 105 | push @$on_devs, $d; 106 | } 107 | } 108 | } 109 | $parse_error->() if $state =~ /\S/; 110 | 111 | my $polclass = "MogileFS::ReplicationPolicy::MultipleHosts"; 112 | my $pol = $polclass->new; 113 | my $rr = $pol->replicate_to( 114 | fid => 1, 115 | on_devs => $on_devs, 116 | all_devs => $devs, 117 | failed => {}, 118 | min => $min, 119 | ); 120 | return $rr->t_as_string; 121 | } 122 | 123 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/AtomStream.pm: -------------------------------------------------------------------------------- 1 | package Perlbal::Plugin::AtomStream; 2 | 3 | use URI; 4 | 5 | use Perlbal; 6 | use strict; 7 | use warnings; 8 | 9 | our @subs; # subscribers 10 | our @recent; # recent items in format [$epoch, $atom_ref, $path_segments_arrayref] 11 | 12 | our $last_timestamp = 0; 13 | 14 | use constant MAX_LAG => 262144; 15 | 16 | sub InjectFeed { 17 | my $class = shift; 18 | my ($atomref, $path) = @_; 19 | 20 | # maintain queue of last 60 seconds worth of posts 21 | my $now = time(); 22 | my @put_segments = URI->new($path)->path_segments; 23 | push @recent, [ $now, $atomref, \@put_segments ]; 24 | shift @recent while @recent && $recent[0][0] <= $now - 60; 25 | 26 | emit_timestamp($now) if $now > $last_timestamp; 27 | 28 | my $need_clean = 0; 29 | foreach my $s (@subs) { 30 | if ($s->{closed}) { 31 | $need_clean = 1; 32 | next; 33 | } 34 | 35 | next unless filter(\@put_segments, $s->{scratch}{get_segments}); 36 | 37 | my $lag = $s->{write_buf_size}; 38 | 39 | if ($lag > MAX_LAG) { 40 | $s->{scratch}{skipped_atom}++; 41 | } else { 42 | if (my $skip_count = $s->{scratch}{skipped_atom}) { 43 | $s->{scratch}{skipped_atom} = 0; 44 | $s->write(\ "\n"); 45 | } 46 | $s->watch_write(0) if $s->write($atomref); 47 | } 48 | } 49 | 50 | if ($need_clean) { 51 | @subs = grep { ! $_->{closed} } @subs; 52 | } 53 | } 54 | 55 | sub emit_timestamp { 56 | my $time = shift; 57 | $last_timestamp = $time; 58 | foreach my $s (@subs) { 59 | next if $s->{closed}; 60 | $s->{alive_time} = $time; 61 | $s->write(\ "\n"); 62 | } 63 | } 64 | 65 | sub filter { 66 | my ($put, $get) = @_; 67 | return 0 if scalar @$put < scalar @$get; 68 | for( my $i = 0 ; $i < scalar @$get ; $i++) { 69 | return 0 if $put->[$i] ne $get->[$i]; 70 | } 71 | return 1; 72 | } 73 | 74 | # called when we're being added to a service 75 | sub register { 76 | my ($class, $svc) = @_; 77 | 78 | Perlbal::Socket::register_callback(1, sub { 79 | my $now = time(); 80 | emit_timestamp($now) if $now > $last_timestamp; 81 | return 1; 82 | }); 83 | 84 | $svc->register_hook('AtomStream', 'start_http_request', sub { 85 | my Perlbal::ClientProxy $self = shift; 86 | my Perlbal::HTTPHeaders $hds = $self->{req_headers}; 87 | return 0 unless $hds; 88 | my $uri = URI->new($hds->request_uri); 89 | my @get_segments = $uri->path_segments; 90 | $self->{scratch}{get_segments} = \@get_segments; 91 | return 0 unless pop @get_segments eq 'atom-stream.xml'; 92 | my %params = $uri->query_form; 93 | my $since = $params{since} =~ /\d+/ ? $params{since} : 0; 94 | 95 | my $res = $self->{res_headers} = Perlbal::HTTPHeaders->new_response(200); 96 | $res->header("Content-Type", "text/xml"); 97 | $res->header('Connection', 'close'); 98 | 99 | push @subs, $self; 100 | 101 | $self->write($res->to_string_ref); 102 | 103 | my $last_rv = $self->write(\ "\n\n"); 104 | 105 | # if they'd like a playback, give them all items >= time requested 106 | if ($since) { 107 | foreach my $item (@recent) { 108 | next if $item->[0] < $since; 109 | next unless filter($item->[2], \@get_segments); 110 | $last_rv = $self->write($item->[1]); 111 | } 112 | } 113 | 114 | $self->watch_write(0) if $last_rv; 115 | return 1; 116 | }); 117 | 118 | return 1; 119 | } 120 | 121 | # called when we're no longer active on a service 122 | sub unregister { 123 | my ($class, $svc) = @_; 124 | 125 | return 1; 126 | } 127 | 128 | # called when we are loaded 129 | sub load { 130 | return 1; 131 | } 132 | 133 | # called for a global unload 134 | sub unload { 135 | return 1; 136 | } 137 | 138 | 1; 139 | -------------------------------------------------------------------------------- /t/20-filepaths.t: -------------------------------------------------------------------------------- 1 | # -*-perl-*- 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More; 6 | use FindBin qw($Bin); 7 | use Time::HiRes qw(sleep); 8 | 9 | use MogileFS::Server; 10 | 11 | BEGIN { 12 | $ENV{TESTING} = 1; 13 | } 14 | 15 | use MogileFS::Test; 16 | find_mogclient_or_skip(); 17 | 18 | # create temp mysql db, 19 | # use mogadm to init it, 20 | # mogstored on temp dir, 21 | # register mogstored temp dir, 22 | # mogilefsd startup, 23 | # add file, 24 | # etc 25 | 26 | plan skip_all => "Filepaths plugin has been separated from the server, a bit of work is needed to make the tests run again."; 27 | exit 0; 28 | 29 | my $sto = eval { temp_store(); }; 30 | if ($sto) { 31 | plan tests => 19; 32 | } else { 33 | plan skip_all => "Can't create temporary test database: $@"; 34 | exit 0; 35 | } 36 | 37 | my $dbh = $sto->dbh; 38 | my $rv; 39 | 40 | use File::Temp; 41 | my $mogroot = File::Temp::tempdir( CLEANUP => 1 ); 42 | mkdir("$mogroot/dev1") or die "Failed to create dev1 dir: #!"; 43 | 44 | my $ms = create_mogstored("127.0.1.1", $mogroot); 45 | 46 | while (! -e "$mogroot/dev1/usage") { 47 | print "Waiting on usage...\n"; 48 | sleep(.25); 49 | } 50 | 51 | local $ENV{PERL5OPT} = "-MMogileFS::Plugin::FilePaths"; 52 | my $tmptrack = create_temp_tracker($sto, ["--plugins=FilePaths"]); 53 | ok($tmptrack); 54 | 55 | my $mogc = MogileFS::Client->new( 56 | domain => "testdom", 57 | hosts => [ "127.0.0.1:7001" ], 58 | ); 59 | my $be = $mogc->{backend}; # gross, reaching inside of MogileFS::Client 60 | 61 | # test some basic commands to backend 62 | ok($tmptrack->mogadm("domain", "add", "testdom"), "created test domain"); 63 | ok($tmptrack->mogadm("class", "add", "testdom", "test", "--mindevcount=1"), "created test class in testdom"); 64 | ok($tmptrack->mogadm("host", "add", "host", "--ip=127.0.1.1", "--status=alive"), "created host"); 65 | ok($tmptrack->mogadm("device", "add", "host", 1), "created dev1 on host"); 66 | 67 | ok($mogc->filepaths_enable, "Filepaths enabled successfully"); 68 | 69 | # wait for monitor 70 | { 71 | my $was = $be->{timeout}; # can't use local on phash :( 72 | $be->{timeout} = 10; 73 | ok($be->do_request("do_monitor_round", {}), "waited for monitor") 74 | or die "Failed to wait for monitor"; 75 | $be->{timeout} = $was; 76 | } 77 | 78 | my $data = "My test file.\n" x 1024; 79 | 80 | # create one sample file 81 | { 82 | my $fh = $mogc->new_file("/bar/file1.txt", "test"); 83 | ok($fh, "got filehandle"); 84 | unless ($fh) { 85 | die "Error: " . $mogc->errstr; 86 | } 87 | 88 | print $fh $data; 89 | ok(close($fh), "closed file"); 90 | } 91 | 92 | { 93 | my $fh = $mogc->new_file("foo.txt", "test"); 94 | is($fh, undef, "File without absolute path should fail to be created"); 95 | } 96 | 97 | { 98 | my $dir = $mogc->filepaths_list_directory('/'); 99 | ok($dir, "Got a directory listing for /"); 100 | 101 | my %files; 102 | my $filecount = $dir->{files}; 103 | 104 | for (my $i = 0; $i < $filecount; $i++) { 105 | my $prefix = "file$i"; 106 | my %nodeinfo; 107 | $nodeinfo{type} = $dir->{"$prefix.type"}; 108 | my $filename = $dir->{$prefix}; 109 | $files{$filename} = \%nodeinfo; 110 | } 111 | ok(!$files{'foo.txt'}, "foo.txt didn't end up in the listing"); 112 | my $bar = $files{'bar'}; 113 | ok($bar, "/bar is in the listing"); 114 | is($bar->{type}, "D", "/bar is a directory"); 115 | } 116 | 117 | { 118 | my $dir = $mogc->filepaths_list_directory('/bar'); 119 | ok($dir, "Got directory listing for /bar"); 120 | 121 | my %files; 122 | my $filecount = $dir->{files}; 123 | 124 | for (my $i = 0; $i < $filecount; $i++) { 125 | my $prefix = "file$i"; 126 | my %nodeinfo; 127 | $nodeinfo{type} = $dir->{"$prefix.type"}; 128 | $nodeinfo{size} = $dir->{"$prefix.size"}; 129 | my $filename = $dir->{$prefix}; 130 | $files{$filename} = \%nodeinfo; 131 | } 132 | 133 | my $file1 = $files{'file1.txt'}; 134 | ok($file1, "/file1.txt is in the listing"); 135 | is($file1->{type}, "F", "Type of file1.txt is correct"); 136 | is($file1->{size}, length($data), "Size of file1.txt is correct"); 137 | } 138 | 139 | ok($mogc->filepaths_disable, "Filepaths disabled successfully"); 140 | 141 | # vim: filetype=perl 142 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/Highpri.pm: -------------------------------------------------------------------------------- 1 | ########################################################################### 2 | # plugin that makes some requests high priority. this is very LiveJournal 3 | # specific, as this makes requests to the client protocol be treated as 4 | # high priority requests. 5 | ########################################################################### 6 | 7 | package Perlbal::Plugin::Highpri; 8 | 9 | use strict; 10 | use warnings; 11 | 12 | # keep track of services we're loaded for 13 | our %Services; 14 | 15 | # called when we're being added to a service 16 | sub register { 17 | my ($class, $svc) = @_; 18 | 19 | # create a compiled regexp for very frequent use later 20 | my $uri_check = qr{^(?:/interface/(?:xmlrpc|flat)|/login\.bml)$}; 21 | my $host_check = undef; 22 | 23 | # setup default extra config info 24 | $svc->{extra_config}->{highpri_uri_check_str} = '^(?:/interface/(?:xmlrpc|flat)|/login\.bml)$'; 25 | $svc->{extra_config}->{highpri_host_check_str} = 'undef'; 26 | 27 | # config setter reference 28 | my $config_set = sub { 29 | my ($out, $what, $val) = @_; 30 | return 0 unless $what && $val; 31 | 32 | # setup an error sub 33 | my $err = sub { 34 | $out->("ERROR: $_[0]") if $out; 35 | return 0; 36 | }; 37 | 38 | # if they said undef, that's not a regexp, that means use none 39 | my $temp; 40 | unless ($val eq 'undef' || $val eq 'none' || $val eq 'null') { 41 | # verify this regexp works? do it in an eval because qr will die 42 | # if we give it something invalid 43 | eval { 44 | $temp = qr{$val}; 45 | }; 46 | return $err->("Invalid regular expression") if $@ || !$temp; 47 | } 48 | 49 | # see what they want to set and set it 50 | if ($what =~ /^uri_pattern/i) { 51 | $uri_check = $temp; 52 | $svc->{extra_config}->{highpri_uri_check_str} = $val; 53 | } elsif ($what =~ /^host_pattern/i) { 54 | $host_check = $temp; 55 | $svc->{extra_config}->{highpri_host_check_str} = $val; 56 | } else { 57 | return $err->("Plugin understands: uri_pattern, host_pattern"); 58 | } 59 | 60 | # 1 for success! 61 | return 1; 62 | }; 63 | 64 | # register things to take in configuration regular expressions 65 | $svc->register_setter('Highpri', 'uri_pattern', $config_set); 66 | $svc->register_setter('Highpri', 'host_pattern', $config_set); 67 | 68 | # more complicated statistics 69 | $svc->register_hook('Highpri', 'make_high_priority', sub { 70 | my Perlbal::ClientProxy $cp = shift; 71 | 72 | # check it against our compiled regexp 73 | return 1 if $uri_check && 74 | $cp->{req_headers}->request_uri =~ /$uri_check/; 75 | if ($host_check) { 76 | my $hostname = $cp->{req_headers}->header('Host'); 77 | return 1 if $hostname && $hostname =~ /$host_check/; 78 | } 79 | 80 | # doesn't fit, so return 0 81 | return 0; 82 | }); 83 | 84 | # mark this service as being active in this plugin 85 | $Services{"$svc"} = $svc; 86 | 87 | return 1; 88 | } 89 | 90 | # called when we're no longer active on a service 91 | sub unregister { 92 | my ($class, $svc) = @_; 93 | 94 | # clean up time 95 | $svc->unregister_hooks('Highpri'); 96 | $svc->unregister_setters('Highpri'); 97 | return 1; 98 | } 99 | 100 | # load global commands for querying this plugin on what's up 101 | sub load { 102 | # setup a command to see what the patterns are 103 | Perlbal::register_global_hook('manage_command.patterns', sub { 104 | my @res = ("High priority pattern buffer:"); 105 | 106 | foreach my $svc (values %Services) { 107 | push @res, "SET $svc->{name}.highpri.uri_pattern = $svc->{extra_config}->{highpri_uri_check_str}"; 108 | push @res, "SET $svc->{name}.highpri.host_pattern = $svc->{extra_config}->{highpri_host_check_str}"; 109 | } 110 | 111 | push @res, "."; 112 | return \@res; 113 | }); 114 | 115 | return 1; 116 | } 117 | 118 | # unload our global commands, clear our service object 119 | sub unload { 120 | Perlbal::unregister_global_hook('manage_command.patterns'); 121 | %Services = (); 122 | return 1; 123 | } 124 | 125 | 1; 126 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/EchoService.pm: -------------------------------------------------------------------------------- 1 | ########################################################################### 2 | # simple plugin demonstrating how to create an add-on service for Perlbal 3 | # using the plugin infrastructure 4 | ########################################################################### 5 | 6 | package Perlbal::Plugin::EchoService; 7 | 8 | use strict; 9 | use warnings; 10 | 11 | # on load we need to define the service and any parameters we want 12 | sub load { 13 | 14 | # define the echo service, which instantiates this type of object 15 | Perlbal::Service::add_role( 16 | echo => \&Perlbal::Plugin::EchoService::Client::new, 17 | ); 18 | 19 | # add up custom configuration options that people are allowed to set on the echo_service 20 | Perlbal::Service::add_tunable( 21 | # allow the following: 22 | # SET myservice.echo_delay = 5 23 | # defines how long to wait between getting text and echoing it back 24 | echo_delay => { 25 | des => "Time in seconds to pause before sending text back using the echo service.", 26 | default => 0, # no delay 27 | check_role => "echo", 28 | check_type => "int", 29 | } 30 | ); 31 | 32 | return 1; 33 | } 34 | 35 | # remove the various things we've hooked into, this is required as a way of 36 | # being good to the system... 37 | sub unload { 38 | Perlbal::Service::remove_tunable('echo_delay'); 39 | Perlbal::Service::remove_role('echo'); 40 | return 1; 41 | } 42 | 43 | 44 | ########################################################################### 45 | # this is the implementation of the client that gets instantiated by the 46 | # service. (which is really all a service does - instantiate the right 47 | # type of client, and store some information) 48 | ########################################################################### 49 | 50 | package Perlbal::Plugin::EchoService::Client; 51 | use strict; 52 | use warnings; 53 | 54 | use base "Perlbal::Socket"; 55 | use fields ('service', # the service we're from 56 | 'buf'); # the buffer of what we're reading 57 | 58 | # create a new object of this class 59 | sub new { 60 | my $class = "Perlbal::Plugin::EchoService::Client"; 61 | my ($service, $sock) = @_; 62 | my $self = fields::new($class); 63 | $self->SUPER::new($sock); 64 | $self->{service} = $service; 65 | $self->{buf} = ""; # what we've read so far, not forming a complete line 66 | 67 | $self->watch_read(1); 68 | return $self; 69 | } 70 | 71 | # called when we are readable - i.e. there is data available 72 | sub event_read { 73 | my Perlbal::Plugin::EchoService::Client $self = shift; 74 | 75 | # try to read in 1k of data, remember to close if you get undef, as that means 76 | # something went wrong, or the socket was closed 77 | my $bref = $self->read(1024); 78 | return $self->close() unless defined $bref; 79 | $self->{buf} .= $$bref; 80 | 81 | # now, parse out any lines that we have gotten. this just removes data line by 82 | # line so we can handle it. 83 | while ($self->{buf} =~ s/^(.+?)\r?\n//) { 84 | my $line = $1; 85 | 86 | # package up a sub to do what we want. this is in a coderef because we either 87 | # need to call it now or schedule it for later. saves some duplication. 88 | my $do_echo = sub { $self->write("$line\r\n"); }; 89 | 90 | # if they want a delay, we have to schedule this for later 91 | if (my $delay = $self->{service}->{extra_config}->{echo_delay}) { 92 | # schedule 93 | Danga::Socket->AddTimer($delay, $do_echo); 94 | 95 | } else { 96 | # immediately, so run it 97 | $do_echo->(); 98 | 99 | } 100 | } 101 | } 102 | 103 | # called when we are writeable - that is, we are allowed to write data now. try to 104 | # flush any existing data and then if we have nothing in the write buffer left, 105 | # go ahead and stop notifying us about writeability. 106 | sub event_write { 107 | my Perlbal::Plugin::EchoService::Client $self = shift; 108 | $self->watch_write(0) if $self->write(undef); 109 | } 110 | 111 | # if we run into some socket error, just close 112 | sub event_err { 113 | my Perlbal::Plugin::EchoService::Client $self = shift; 114 | $self->close; 115 | } 116 | 117 | # same thing if we get a hup 118 | sub event_hup { 119 | my Perlbal::Plugin::EchoService::Client $self = shift; 120 | $self->close; 121 | } 122 | 123 | 1; 124 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/SocketSSL.pm: -------------------------------------------------------------------------------- 1 | # Base class for SSL sockets. 2 | # 3 | # This is a simple class that extends Danga::Socket and contains an IO::Socket::SSL 4 | # for the purpose of allowing non-blocking SSL in Perlbal. 5 | # 6 | # WARNING: this code will break IO::Socket::SSL if you use it in any plugins or 7 | # have custom Perlbal modifications that use it. you will run into issues. This 8 | # is because we override the close method to prevent premature closure of the socket, 9 | # so you will end up with the socket not closing properly. 10 | # 11 | # Copyright 2007, Mark Smith . 12 | # 13 | # This file is licensed under the same terms as Perl itself. 14 | 15 | package Perlbal::SocketSSL; 16 | 17 | use strict; 18 | use warnings; 19 | no warnings qw(deprecated); 20 | 21 | use Danga::Socket 1.44; 22 | use IO::Socket::SSL 0.98; 23 | use Errno qw( EAGAIN ); 24 | 25 | use base 'Danga::Socket'; 26 | use fields qw( listener create_time ); 27 | 28 | # magic IO::Socket::SSL crap to make it play nice with us 29 | { 30 | no strict 'refs'; 31 | no warnings 'redefine'; 32 | 33 | # replace IO::Socket::SSL::close with our own code... 34 | my $orig = *IO::Socket::SSL::close{CODE}; 35 | *IO::Socket::SSL::close = sub { 36 | my $self = shift() 37 | or return IO::Socket::SSL::_invalid_object(); 38 | 39 | # if we have args, close ourselves (second call!), else don't 40 | if (exists ${*$self}->{__close_args}) { 41 | $orig->($self, @{${*$self}->{__close_args}}); 42 | } else { 43 | ${*$self}->{__close_args} = [ @_ ]; 44 | ${*$self}->{_danga_socket}->close('intercepted_ssl_close'); 45 | } 46 | }; 47 | } 48 | 49 | # called: CLASS->new( $sock, $tcplistener ) 50 | sub new { 51 | my Perlbal::SocketSSL $self = shift; 52 | $self = fields::new( $self ) unless ref $self; 53 | 54 | Perlbal::objctor($self); 55 | 56 | my ($sock, $listener) = @_; 57 | 58 | ${*$sock}->{_danga_socket} = $self; 59 | $self->{listener} = $listener; 60 | $self->{create_time} = time; 61 | 62 | $self->SUPER::new($sock); 63 | 64 | # TODO: would be good to have an overall timeout so that we can 65 | # kill sockets that are open and just sitting there. "ssl_handshake_timeout" 66 | # or something like that... 67 | 68 | return $self; 69 | } 70 | 71 | # this is nonblocking, it attempts to setup SSL and if it can't then 72 | # it returns whether it needs to read or write. we then setup to wait 73 | # for the event it indicates and then wait. when that event fires, we 74 | # call down again, and repeat the process until we have setup the 75 | # SSL connection. 76 | sub try_accept { 77 | my Perlbal::SocketSSL $self = shift; 78 | 79 | my $sock = $self->{sock}->accept_SSL; 80 | 81 | if (defined $sock) { 82 | # looks like we got it! let's steal it from ourselves 83 | # so Danga::Socket gives up on it and we can send 84 | # it out to someone else. (we discard the return value 85 | # as we already have it in $sock) 86 | # 87 | # of course, life isn't as simple as that. we have to do 88 | # some trickery with the ordering here to ensure that we 89 | # don't setup the new class until after the Perlbal::SocketSSL 90 | # goes away according to Danga::Socket. 91 | # 92 | # if we don't do it this way, we get nasty errors because 93 | # we (this object) still exists in the DescriptorMap of 94 | # Danga::Socket when the new Perlbal::ClientXX tries to 95 | # insert itself there. 96 | 97 | # removes us from the active polling, closes up shop, but 98 | # save our fd first! 99 | my $fd = $self->{fd}; 100 | $self->steal_socket; 101 | 102 | # finish blowing us away 103 | my $ref = Danga::Socket->DescriptorMap(); 104 | delete $ref->{$fd}; 105 | 106 | # now stick the new one in 107 | $self->{listener}->class_new_socket($sock); 108 | return; 109 | } 110 | 111 | # nope, let's see if we can continue the process 112 | if ($! == EAGAIN) { 113 | if ($SSL_ERROR == SSL_WANT_READ) { 114 | $self->watch_read(1); 115 | } elsif ($SSL_ERROR == SSL_WANT_WRITE) { 116 | $self->watch_write(1); 117 | } else { 118 | $self->close('invalid_ssl_state'); 119 | } 120 | } else { 121 | $self->close('invalid_ssl_error'); 122 | } 123 | } 124 | 125 | sub event_read { 126 | $_[0]->watch_read(0); 127 | $_[0]->try_accept; 128 | } 129 | 130 | sub event_write { 131 | $_[0]->watch_write(0); 132 | $_[0]->try_accept; 133 | } 134 | 135 | 1; 136 | -------------------------------------------------------------------------------- /lib/Mogstored/ChildProcess/DiskUsage.pm: -------------------------------------------------------------------------------- 1 | package Mogstored::ChildProcess::DiskUsage; 2 | use strict; 3 | use base 'Mogstored::ChildProcess'; 4 | 5 | my $docroot; 6 | 7 | sub pre_exec_init { 8 | my $class = shift; 9 | $SIG{TERM} = 'DEFAULT'; # override custom one from earlier 10 | $ENV{MOG_DOCROOT} = Perlbal->service('mogstored')->{docroot}; 11 | } 12 | 13 | sub run { 14 | $docroot = $ENV{MOG_DOCROOT}; 15 | die "\$ENV{MOG_DOCROOT} not set" unless $docroot; 16 | die "\$ENV{MOG_DOCROOT} not set to a directory" unless -d $docroot; 17 | 18 | # (runs in exec'd child process) 19 | $0 = "mogstored [diskusage]"; 20 | select((select(STDOUT), $|++)[0]); 21 | 22 | my $start_ppid = getppid(); 23 | 24 | # Discover whether or not we have GNU df. 25 | my $gnu_df = ''; 26 | `df -P / 2>/dev/null >/dev/null`; 27 | if ($? eq 0) { 28 | $gnu_df = '-P'; 29 | } 30 | 31 | while (1) { 32 | look_at_disk_usage($gnu_df); 33 | sleep 10; 34 | 35 | # shut ourselves down if our parent mogstored 36 | # has gone away. 37 | my $ppid = getppid(); 38 | exit(0) unless $ppid == $start_ppid && kill(0,$ppid); 39 | } 40 | } 41 | 42 | sub look_at_disk_usage { 43 | my $err = sub { warn "$_[0]\n"; }; 44 | my $path = $ENV{MOG_DOCROOT}; 45 | $path =~ s!/$!!; 46 | my $gnu_df = shift; 47 | 48 | # find all devices below us 49 | my @devnum; 50 | if (opendir(D, $path)) { 51 | @devnum = grep { /^dev\d+$/ } readdir(D); 52 | closedir(D); 53 | } else { 54 | return $err->("Failed to open $path: $!"); 55 | } 56 | 57 | foreach my $devnum (@devnum) { 58 | my $rval = `df $gnu_df -l -k $path/$devnum`; 59 | my $uperK = ($rval =~ /512-blocks/i) ? 2 : 1; # units per kB 60 | foreach my $l (split /\r?\n/, $rval) { 61 | next unless $l =~ /^(.+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(.+)\s+(.+)$/; 62 | my ($dev, $total, $used, $avail, $useper, $disk) = ($1, $2, $3, $4, $5, $6); 63 | 64 | unless ($disk =~ m!$devnum/?$!) { 65 | $disk = "$path/$devnum"; 66 | } 67 | 68 | # FIXME: We're stupidly throwing away the 'avail' value here. 69 | # This causes mogilefs to run aground when used with ext 70 | # partitions using reserved space. Drop the reserved space from 71 | # the total, and in the future add available to the device table 72 | # and just use that. 73 | $total = $used + $avail; 74 | 75 | # create string to print 76 | my $now = time; 77 | my $output = { 78 | time => time(), 79 | device => $dev, # /dev/sdh1 80 | total => int($total / $uperK), # integer: total KiB blocks 81 | used => int($used / $uperK), # integer: used KiB blocks 82 | available => int($avail / $uperK), # integer: available KiB blocks 83 | 'use' => $useper, # "45%" 84 | disk => $disk, # mount point of disk (/var/mogdata/dev8), or path if not a mount 85 | }; 86 | 87 | if ($ENV{MOG_DEV_USAGE_VIA_DU}) { 88 | my $size = `du -k -c -s $path/$devnum`; 89 | if ($size =~ /^(\d+)/) { 90 | $output->{used} = $1; 91 | } 92 | } 93 | 94 | # size of old file we'll be overwriting in place (we'll want 95 | # to pad with newlines/spaces, before we truncate it, for 96 | # minimizing races) 97 | my $ufile = "$disk/usage"; 98 | my $old_size = (-s $ufile) || 0; 99 | my $mode = $old_size ? "+<" : ">"; 100 | 101 | # string we'll be writing 102 | my $new_data = ""; 103 | foreach (sort keys %$output) { 104 | $new_data .= "$_: $output->{$_}\n"; 105 | } 106 | 107 | my $new_size = length $new_data; 108 | my $pad_len = $old_size > $new_size ? ($old_size - $new_size) : 0; 109 | $new_data .= "\n" x $pad_len; 110 | 111 | # write the file, all at once (with padding) then remove padding 112 | my $rv = open(my $fh, $mode, $ufile); 113 | unless ($rv) { 114 | $err->("Unable to open '$ufile' for writing: $!"); 115 | next; 116 | } 117 | unless (syswrite($fh, $new_data)) { 118 | close($fh); 119 | $err->("Error writing to '$ufile': $!"); 120 | next; 121 | } 122 | truncate($fh, $new_size) if $pad_len; 123 | close($fh); 124 | } 125 | } 126 | } 127 | 128 | 129 | 1; 130 | -------------------------------------------------------------------------------- /lib/MogileFS/Domain.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::Domain; 2 | use strict; 3 | use warnings; 4 | use MogileFS::Util qw(throw); 5 | 6 | # -------------------------------------------------------------------------- 7 | # Class methods: 8 | # -------------------------------------------------------------------------- 9 | 10 | my %singleton; # dmid -> MogileFS::Domain 11 | 12 | my %id2name; # dmid -> domainname(namespace) 13 | my %name2id; # domainname(namespace) -> dmid 14 | 15 | my $last_load = 0; 16 | 17 | # return singleton MogileFS::Domain, given a dmid 18 | sub of_dmid { 19 | my ($pkg, $dmid) = @_; 20 | return undef unless $dmid; 21 | return $singleton{$dmid} if $singleton{$dmid}; 22 | 23 | my $ns = $pkg->name_of_id($dmid) 24 | or return undef; 25 | 26 | return $singleton{$dmid} = bless { 27 | dmid => $dmid, 28 | ns => $ns, 29 | }, $pkg; 30 | } 31 | 32 | # return singleton MogileFS::Domain, given a domain(namespace) 33 | sub of_namespace { 34 | my ($pkg, $ns) = @_; 35 | return undef unless $ns; 36 | my $dmid = $pkg->id_of_name($ns) 37 | or return undef; 38 | return MogileFS::Domain->of_dmid($dmid); 39 | } 40 | 41 | # name to dmid, reloading if not in cache 42 | sub id_of_name { 43 | my ($pkg, $domain) = @_; 44 | return $name2id{$domain} if $name2id{$domain}; 45 | $pkg->reload_domains; 46 | return $name2id{$domain}; 47 | } 48 | 49 | # dmid to name, reloading if not in cache 50 | sub name_of_id { 51 | my ($pkg, $dmid) = @_; 52 | return $id2name{$dmid} if $id2name{$dmid}; 53 | $pkg->reload_domains; 54 | return $id2name{$dmid}; 55 | } 56 | 57 | # force reload of cache 58 | sub reload_domains { 59 | my $now = time(); 60 | my $sto = Mgd::get_store(); 61 | %name2id = $sto->get_all_domains; 62 | %id2name = (); 63 | while (my ($k, $v) = each %name2id) { 64 | $id2name{$v} = $k; 65 | } 66 | 67 | # Blow singleton cache on reload. Otherwise a *change* in data may not be 68 | # reflected. 69 | %singleton = (); 70 | 71 | $last_load = $now; 72 | } 73 | 74 | # FIXME: should probably have an invalidate_cache variant that only 75 | # flushes locally (for things like "get_domains" or "get_hosts", where 76 | # it needs to be locally correct for the semantics of the command, but 77 | # no need to propagate a cache invalidation to our peers) 78 | sub invalidate_cache { 79 | $last_load = 0; 80 | %id2name = (); 81 | %name2id = (); 82 | if (my $worker = MogileFS::ProcManager->is_child) { 83 | $worker->invalidate_meta("domain"); 84 | } 85 | } 86 | 87 | sub check_cache { 88 | my $pkg = shift; 89 | my $now = time(); 90 | return if $last_load > $now - 5; 91 | MogileFS::Domain->reload_domains; 92 | } 93 | 94 | sub domains { 95 | my $pkg = shift; 96 | $pkg->check_cache; 97 | return map { $pkg->of_dmid($_) } keys %id2name; 98 | } 99 | 100 | # create a new domain given a name, returns MogileFS::Domain object on success. 101 | # throws errors on failure. error codes include: 102 | # "dup" -- on duplicate name 103 | sub create { 104 | my ($pkg, $name) = @_; 105 | 106 | # throws 'dup': 107 | my $dmid = Mgd::get_store()->create_domain($name) 108 | or die "create domain didn't return a dmid"; 109 | 110 | # return the domain id we created 111 | MogileFS::Domain->invalidate_cache; 112 | return MogileFS::Domain->of_dmid($dmid); 113 | } 114 | 115 | # -------------------------------------------------------------------------- 116 | # Instance methods: 117 | # -------------------------------------------------------------------------- 118 | 119 | sub id { $_[0]->{dmid} } 120 | sub name { $_[0]->{ns} } 121 | 122 | sub has_files { 123 | my $self = shift; 124 | return 1 if $Mgd::_T_DOM_HAS_FILES; 125 | return Mgd::get_store()->domain_has_files($self->id); 126 | } 127 | 128 | sub classes { 129 | my $dom = shift; 130 | # return a bunch of class objects for this domain 131 | return MogileFS::Class->classes_of_domain($dom); 132 | } 133 | 134 | # returns true if deleted. throws exceptions on errors. exception codes: 135 | # 'has_files' if it has files. 136 | sub delete { 137 | my $self = shift; 138 | throw("has_files") if $self->has_files; 139 | # TODO: delete its classes 140 | my $rv = Mgd::get_store()->delete_domain($self->id); 141 | MogileFS::Domain->invalidate_cache; 142 | return $rv; 143 | } 144 | 145 | # returns named class of domain 146 | sub class { 147 | my ($dom, $clname) = @_; 148 | foreach my $cl (MogileFS::Class->classes_of_domain($dom)) { 149 | return $cl if $cl->name eq $clname; 150 | } 151 | return; 152 | } 153 | 154 | sub create_class { 155 | my ($dom, $clname) = @_; 156 | return MogileFS::Class->create_class($dom, $clname); 157 | } 158 | 159 | 1; 160 | -------------------------------------------------------------------------------- /lib/MogileFS/DevFID.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::DevFID; 2 | use strict; 3 | use warnings; 4 | use overload '""' => \&as_string; 5 | use Carp qw(croak); 6 | 7 | sub new { 8 | my ($class, $devarg, $fidarg) = @_; 9 | return bless { 10 | devid => ref $devarg ? $devarg->id : $devarg, 11 | dev => ref $devarg ? $devarg : undef, 12 | fidid => ref $fidarg ? $fidarg->id : $fidarg, 13 | fid => ref $fidarg ? $fidarg : undef, 14 | }, $class; 15 | } 16 | 17 | # -------------------------------------------------------------------------- 18 | 19 | sub devid { $_[0]{devid} } 20 | sub fidid { $_[0]{fidid} } 21 | 22 | sub as_string { 23 | "DevFID[d=" . $_[0]{devid} . ";f=" . $_[0]{fidid} . "]"; 24 | } 25 | 26 | sub device { 27 | my $self = shift; 28 | return $self->{dev} ||= MogileFS::Device->of_devid($self->{devid}); 29 | } 30 | 31 | sub fid { 32 | my $self = shift; 33 | return $self->{fid} ||= MogileFS::FID->new($self->{fidid}); 34 | } 35 | 36 | # returns true if DevFID actually exists in database 37 | sub exists { 38 | my $self = shift; 39 | my $fid = $self->fid; 40 | return (grep { $_ == $self->{devid} } $fid->devids) ? 1 : 0; 41 | } 42 | 43 | sub url { 44 | my $self = shift; 45 | return $self->_make_full_url(0); 46 | } 47 | 48 | sub get_url { 49 | my $self = shift; 50 | return $self->_make_full_url(1); 51 | } 52 | 53 | sub vivify_directories { 54 | my $self = shift; 55 | my $url = $self->url; 56 | MogileFS::Device->vivify_directories($url); 57 | } 58 | 59 | # returns 0 on missing, 60 | # undef on connectivity error, 61 | # else size of file on disk (after HTTP HEAD or mogstored stat) 62 | sub size_on_disk { 63 | my $self = shift; 64 | my $url = $self->get_url; 65 | 66 | # check that it has size (>0) and is reachable (not undef) 67 | return MogileFS::HTTPFile->at($url)->size; 68 | } 69 | 70 | # returns true if size seen matches fid's length 71 | sub size_matches { 72 | my $self = shift; 73 | my $fid = $self->fid; 74 | my $disk_size = $self->size_on_disk; 75 | 76 | # Temporary connectivity error with that disk/machine.. 77 | return 0 unless defined $disk_size; 78 | return 0 if $disk_size == MogileFS::HTTPFile::FILE_MISSING; 79 | 80 | return $disk_size == $fid->length; 81 | } 82 | 83 | # returns just the URI path component without scheme/host 84 | sub uri_path { 85 | my $self = shift; 86 | my $devid = $self->{devid}; 87 | my $fidid = $self->{fidid}; 88 | 89 | my $nfid; 90 | my $len = length $fidid; 91 | if ($len < 10) { 92 | $nfid = '0' x (10 - $len) . $fidid; 93 | } else { 94 | $nfid = $fidid; 95 | } 96 | my ( $b, $mmm, $ttt, $hto ) = ( $nfid =~ m{(\d)(\d{3})(\d{3})(\d{3})} ); 97 | 98 | return "/dev$devid/$b/$mmm/$ttt/$nfid.fid"; 99 | } 100 | 101 | sub _make_full_url { 102 | # set use_get_port to be true to specify to use the get port 103 | my ($self, $use_get_port) = @_; 104 | 105 | # get some information we'll need 106 | my $dev = $self->device or return undef; 107 | my $host = $dev->host or return undef; 108 | return undef unless $host->exists; 109 | 110 | my $path = $self->uri_path; 111 | my $hostip = $host->ip; 112 | my $port = $use_get_port ? $host->http_get_port : $host->http_port; 113 | 114 | return "http://$hostip:$port$path"; 115 | } 116 | 117 | sub add_to_db { 118 | my ($self, $no_lock) = @_; 119 | croak("fidid not non-zero") unless $self->{fidid}; 120 | croak("devid not non-zero") unless $self->{devid}; 121 | 122 | my $sto = Mgd::get_store(); 123 | if ($sto->add_fidid_to_devid($self->{fidid}, $self->{devid})) { 124 | return $self->fid->update_devcount(no_lock => $no_lock); 125 | } else { 126 | # was already on that device 127 | return 1; 128 | } 129 | } 130 | 131 | # Destroy a particular replica of a file via HTTP, remove it 132 | # from the tracker, and update the replication counts to be 133 | # accurate again. 134 | sub destroy { 135 | my $self = shift; 136 | my %opts = @_; 137 | 138 | my $httpfile = MogileFS::HTTPFile->at($self->url) 139 | or die "Creation of HTTPFile object failed."; 140 | 141 | my %delete_opts; 142 | 143 | $delete_opts{ignore_missing} = 1 144 | if $opts{ignore_missing}; 145 | 146 | $httpfile->delete(%delete_opts) 147 | or die "Deletion of file via HTTP failed."; 148 | 149 | my $sto = Mgd::get_store(); 150 | $sto->remove_fidid_from_devid($self->fidid, $self->devid); 151 | $sto->update_devcount($self->fidid); 152 | } 153 | 154 | 1; 155 | 156 | __END__ 157 | 158 | =head1 NAME 159 | 160 | MogileFS::DevFID - represents a FID on a device 161 | 162 | =head1 ABOUT 163 | 164 | This class represents the (devid, fidid) tuple. That is, a specific 165 | version on a file on a specific device. See L and 166 | L. 167 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/ClientManage.pm: -------------------------------------------------------------------------------- 1 | ###################################################################### 2 | # Management connection from a client 3 | ###################################################################### 4 | 5 | package Perlbal::ClientManage; 6 | use strict; 7 | use warnings; 8 | no warnings qw(deprecated); 9 | 10 | use base "Perlbal::Socket"; 11 | use fields ('service', 12 | 'buf', 13 | 'is_http', # bool: is an HTTP request? 14 | 'ctx', # command context 15 | ); 16 | 17 | # ClientManage 18 | sub new { 19 | my Perlbal::ClientManage $self = shift; 20 | my ($service, $sock) = @_; 21 | $self = fields::new($self) unless ref $self; 22 | $self->SUPER::new($sock); 23 | $self->{service} = $service; 24 | $self->{buf} = ""; # what we've read so far, not forming a complete line 25 | 26 | $self->{ctx} = Perlbal::CommandContext->new; 27 | $self->{ctx}->verbose(1); 28 | 29 | $self->watch_read(1); 30 | return $self; 31 | } 32 | 33 | # ClientManage 34 | sub event_read { 35 | my Perlbal::ClientManage $self = shift; 36 | 37 | my $bref; 38 | unless ($self->{is_http}) { 39 | $bref = $self->read(1024); 40 | return $self->close() unless defined $bref; 41 | $self->{buf} .= $$bref; 42 | 43 | if ($self->{buf} =~ /^(?:HEAD|GET|POST) /) { 44 | $self->{is_http} = 1; 45 | $self->{headers_string} .= $$bref; 46 | } 47 | } 48 | 49 | if ($self->{is_http}) { 50 | my $hd = $self->read_request_headers; 51 | return unless $hd; 52 | $self->handle_http(); 53 | return; 54 | } 55 | 56 | while ($self->{buf} =~ s/^(.+?)\r?\n//) { 57 | my $line = $1; 58 | 59 | if ($line =~ /^quit|exit$/) { 60 | $self->close('user_requested_quit'); 61 | return; 62 | } 63 | 64 | my $out = sub { 65 | $self->write("$_[0]\r\n"); 66 | }; 67 | 68 | Perlbal::run_manage_command($line, $out, $self->{ctx}); 69 | } 70 | } 71 | 72 | sub event_write { 73 | my $self = shift; 74 | $self->watch_write(0) if $self->write(undef); 75 | } 76 | 77 | # ClientManage 78 | sub event_err { my $self = shift; $self->close; } 79 | sub event_hup { my $self = shift; $self->close; } 80 | 81 | # HTTP management support 82 | sub handle_http { 83 | my Perlbal::ClientManage $self = shift; 84 | 85 | my $uri = $self->{req_headers}->request_uri; 86 | 87 | my $body; 88 | my $code = "200 OK"; 89 | 90 | my $prebox = sub { 91 | my $cmd = shift; 92 | my $alt = shift; 93 | $body .= "
$cmd
";
 94 |         Perlbal::run_manage_command($cmd, sub {
 95 |             my $line = $_[0] || "";
 96 |             $alt->(\$line) if $alt;
 97 |             $body .= "$line\n";
 98 |         });
 99 |         $body .= "
\n"; 100 | 101 | }; 102 | 103 | $body .= "\n"; 104 | $body .= "\n"; 105 | $body .= "perlbal management interface"; 106 | 107 | if ($uri eq "/") { 108 | $body .= "

perlbal management interface

    "; 109 | $body .= "
  • Sockets
    • "; 110 | $body .= "
  • Perl Objects in use
    • "; 111 | $body .= "
  • Service Details
      "; 112 | foreach my $sname (Perlbal->service_names) { 113 | my Perlbal::Service $svc = Perlbal->service($sname); 114 | next unless $svc; 115 | my $listen = $svc->{listen} ? " ($svc->{listen})" : ""; 116 | $body .= "
    • $sname - $svc->{role}$listen
      • \n"; 117 | } 118 | $body .= "
    • "; 119 | $body .= "
"; 120 | } elsif ($uri eq "/socks") { 121 | $prebox->('socks summary'); 122 | 123 | $prebox->('socks', sub { 124 | ${$_[0]} =~ s!service \'(\w+)\'!$1!; 125 | }); 126 | } elsif ($uri eq "/obj") { 127 | $prebox->('obj'); 128 | } elsif ($uri =~ m!^/service\?(\w+)$!) { 129 | my $service = $1; 130 | $prebox->("show service $service"); 131 | } else { 132 | $code = "404 Not found"; 133 | $body .= "

$code

"; 134 | } 135 | 136 | $body .= "

Perlbal management.

\n"; 137 | $self->write("HTTP/1.0 $code\r\nContent-type: text/html\r\nContent-Length: " . length($body) . 138 | "\r\n\r\n$body"); 139 | $self->write(sub { $self->close; }); 140 | return; 141 | } 142 | 143 | 1; 144 | 145 | 146 | # Local Variables: 147 | # mode: perl 148 | # c-basic-indent: 4 149 | # indent-tabs-mode: nil 150 | # End: 151 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | -- if run out file descriptors in mogilefsd, mogilefsd shouldn't crash. it might 2 | now. needs a test. 3 | 4 | -- change debug level at runtime from mgmt port, propagate to children. 5 | 6 | -- MogileFS::Device ->make_directory on lighttpd isn't exactly right, as WebDAV 7 | spec says MKCOL on an existing directory should return 405 (Method Not Allowed), 8 | which I think is the same as a server without WebDAV enabled... we need to distinguish 9 | between those two cases. (perhaps in Monitor job?) 10 | 405 (Method Not Allowed) - MKCOL can only be executed on a deleted/non-existent resource. 11 | 12 | -- mogdbsetup should use /etc/mogilefs/mogilefsd.conf for upgrade dsn info 13 | 14 | -- fix 5/second in mogadm fsck status. hard-coded to 5. whoops. 15 | 16 | -- in MogileFS::Device, 17 | + # FIXME: don't use local machine's time() for this. time sync 18 | + # issues! instead, the monitor process should track this, 19 | + # noting the difference in relative time between the server's 20 | + # time (in Date: response header) and time in the usage.txt 21 | + # file. 22 | 23 | -- make mogilefsd trackers speak FUSE, so we could mount all of mogilefs using, say: 24 | http://noedler.de/projekte/wdfs/index.html 25 | things like paths could be exposed as extended attributes, or as pseudo files: 26 | cat /mnt/mogile//paths/ 27 | cat /mnt/mogile//contents/ 28 | 29 | -- if create_open before monitor runs yet, block and wait for a round? better than 'no_devices' 30 | might need some marker for 'end of monitoring'? or just wait until we have 1 or 3? 31 | or if they asked for 3, only return 1 in that rare case, preferring latency to redundancy. 32 | plus, we'd know that 1 is writable in last few seconds! 33 | 34 | -- update the 'repl' command for new file_to_replicate table 35 | 36 | -- replication policy error storm when a device is known to be observably down: 37 | 38 | [replicate(28037)] replication policy ran out of suggestions for us replicating fid 197214 39 | [replicate(28037)] replication policy ran out of suggestions for us replicating fid 197237 40 | [replicate(28037)] replication policy ran out of suggestions for us replicating fid 197219 41 | [replicate(28037)] replication policy ran out of suggestions for us replicating fid 197256 42 | [replicate(28037)] replication policy ran out of suggestions for us replicating fid 197226 43 | 44 | -- telnet to 7001 and send "!" will crash. 45 | 46 | -- fsck job/command. need 'last fsck' table per fid? or column? 47 | 48 | -- fix haphazard CapitalStyle vs capital_style in ProcManager for class methods 49 | 50 | -- 'every' func should select on psock, to process parent-sent commands 51 | during worker's breaks 52 | 53 | -- create close could wake a replicate process. 54 | 55 | -- optional 'wait_until_replicated=1' flag to create close, so client doesn't 56 | get success until file is everywhere. 57 | 58 | -- redo/reevaluate the 'unreachable_fids' logic: unreachable should only mean 59 | host/device are up, but file is 404. 60 | 61 | -- test database failures 62 | 63 | -- identify idempotent commands and replay them 'n' times if query worker dies 64 | during processing. 65 | 66 | -- have queries workers be able to broadcast back up to parent "can't parse this" 67 | at which point parent parses it (e.g. "help" command), so admins don't 68 | need to remember the "!" prefix. of course, "!" prefix can always be used to 69 | reach parent faster. 70 | 71 | -- mb_asof handling in find_deviceid seems broken. less than max age? wrong units. 72 | 73 | -- make generic script to write out usage files for people not using mogstored 74 | -- or, let mogstored be run in 'usage' file writing only mode 75 | 76 | -- wake up deleter process? totally overkill, but why not? 77 | 78 | * 404 storms during replicating: (1.5 year old email, might be fixed, verify) 79 | 80 | :: [replicate(12648)] Error: Resource http://10.0.0.82:7500/dev15/0/015/693/0015693821.fid failed: HTTP 404 81 | :: [replicate(12648)] Copier failed replicating 15693821 82 | :: [replicate(12648)] Error: Resource http://10.0.0.82:7500/dev15/0/015/693/0015693819.fid failed: HTTP 404 83 | :: [replicate(12648)] Copier failed replicating 15693819 84 | :: [replicate(12648)] Error: Resource http://10.0.0.81:7500/dev9/0/015/693/0015693844.fid failed: HTTP 404 85 | :: [replicate(12648)] Copier failed replicating 15693844 86 | :: [replicate(12646)] Copier failed replicating 15693846 87 | :: [replicate(12646)] Error: Resource http://10.0.0.82:7500/dev15/0/015/693/0015693821.fid failed: HTTP 404 88 | :: [replicate(12646)] Copier failed replicating 15693821 89 | :: [replicate(12646)] Error: Resource http://10.0.0.81:7500/dev9/0/015/693/0015693844.fid failed: HTTP 404 90 | :: [replicate(12646)] Copier failed replicating 15693844 91 | :: [replicate(12648)] Error: Resource http://10.0.0.81:7500/dev3/0/015/693/0015693848.fid failed: HTTP 404 92 | :: [replicate(12650)] Error: Resource http://10.0.0.82:7500/dev15/0/015/693/0015693819.fid failed: HTTP 404 93 | :: [replicate(12648)] Copier failed replicating 15693848 94 | ...... 95 | 96 | -- fsck for case where row from file_to_replicate(fid,fromdevid) does not exist 97 | in file_on(fid,devid). This is a byproduct of a failed inject. 98 | -------------------------------------------------------------------------------- /lib/MogileFS/Connection/Client.pm: -------------------------------------------------------------------------------- 1 | # A client is a user connection for sending requests to us. Requests 2 | # can either be normal user requests to be sent to a QueryWorker 3 | # or management requests that start with a !. 4 | 5 | package MogileFS::Connection::Client; 6 | 7 | use strict; 8 | use Danga::Socket (); 9 | use base qw{Danga::Socket}; 10 | 11 | use fields qw{read_buf}; 12 | 13 | sub new { 14 | my $self = shift; 15 | $self = fields::new($self) unless ref $self; 16 | $self->SUPER::new( @_ ); 17 | $self->watch_read(1); 18 | return $self; 19 | } 20 | 21 | # Client 22 | sub event_read { 23 | my MogileFS::Connection::Client $self = shift; 24 | 25 | my $bref = $self->read(1024); 26 | return $self->close unless defined $bref; 27 | $self->{read_buf} .= $$bref; 28 | 29 | while ($self->{read_buf} =~ s/^(.*?)\r?\n//) { 30 | next unless length $1; 31 | $self->handle_request($1); 32 | } 33 | } 34 | 35 | sub handle_request { 36 | my ($self, $line) = @_; 37 | 38 | # if it's just 'help', 'h', '?', or something, do that 39 | #if ((substr($line, 0, 1) eq '?') || ($line eq 'help')) { 40 | # MogileFS::ProcManager->SendHelp($_[1]); 41 | # return; 42 | #} 43 | 44 | if ($line =~ /^!(\S+)(?:\s+(.+))?$/) { 45 | my ($cmd, $args) = ($1, $2); 46 | return $self->handle_admin_command($cmd, $args); 47 | } 48 | 49 | MogileFS::ProcManager->EnqueueCommandRequest($line, $self); 50 | } 51 | 52 | sub handle_admin_command { 53 | my ($self, $cmd, $args) = @_; 54 | 55 | my @out; 56 | if ($cmd =~ /^stats$/) { 57 | # print out some stats on the queues 58 | my $uptime = time() - MogileFS::ProcManager->server_starttime; 59 | my $ccount = MogileFS::ProcManager->PendingQueryCount; 60 | my $wcount = MogileFS::ProcManager->BoredQueryWorkerCount; 61 | my $ipcount = MogileFS::ProcManager->QueriesInProgressCount; 62 | my $stats = MogileFS::ProcManager->StatsHash; 63 | push @out, "uptime $uptime", 64 | "pending_queries $ccount", 65 | "processing_queries $ipcount", 66 | "bored_queryworkers $wcount", 67 | map { "$_ $stats->{$_}" } sort keys %$stats; 68 | 69 | } elsif ($cmd =~ /^shutdown/) { 70 | print "User requested shutdown: $args\n"; 71 | kill 15, $$; # kill us, that kills our kids 72 | 73 | } elsif ($cmd =~ /^jobs/) { 74 | # dump out a list of running jobs and pids 75 | MogileFS::ProcManager->foreach_job(sub { 76 | my ($job, $ct, $desired, $pidlist) = @_; 77 | push @out, "$job count $ct"; 78 | push @out, "$job desired $desired"; 79 | push @out, "$job pids " . join(' ', @$pidlist); 80 | }); 81 | 82 | } elsif ($cmd =~ /^want/) { 83 | # !want 84 | # set the new desired staffing level for a class 85 | if ($args =~ /^(\d+)\s+(\S+)/) { 86 | my ($count, $job) = ($1, $2); 87 | 88 | $count = 500 if $count > 500; 89 | 90 | # now make sure it's a real job 91 | if (MogileFS::ProcManager->is_valid_job($job)) { 92 | MogileFS::ProcManager->request_job_process($job, $count); 93 | push @out, "Now desiring $count children doing '$job'."; 94 | } else { 95 | my $classes = join(", ", MogileFS::ProcManager->valid_jobs); 96 | push @out, "ERROR: Invalid class '$job'. Valid classes: $classes"; 97 | } 98 | } else { 99 | push @out, "ERROR: usage: !want "; 100 | } 101 | 102 | } elsif ($cmd =~ /^to/) { 103 | # !to 104 | # sends to all children of 105 | if ($args =~ /^(\S+)\s+(.+)/) { 106 | my $ct = MogileFS::ProcManager->ImmediateSendToChildrenByJob($1, $2); 107 | push @out, "Message sent to $ct children."; 108 | 109 | } else { 110 | push @out, "ERROR: usage: !to "; 111 | } 112 | 113 | } elsif ($cmd =~ /^queue/ || $cmd =~ /^pend/) { 114 | MogileFS::ProcManager->foreach_pending_query(sub { 115 | my ($client, $query) = @_; 116 | push @out, $query; 117 | }); 118 | 119 | } elsif ($cmd =~ /^watch/) { 120 | if (MogileFS::ProcManager->RemoveErrorWatcher($self)) { 121 | push @out, "Removed you from watcher list."; 122 | } else { 123 | MogileFS::ProcManager->AddErrorWatcher($self); 124 | push @out, "Added you to watcher list."; 125 | } 126 | 127 | } elsif ($cmd =~ /^recent/) { 128 | # show the most recent N queries 129 | push @out, MogileFS::ProcManager->RecentQueries; 130 | 131 | } elsif ($cmd =~ /^version/) { 132 | # show the most recent N queries 133 | push @out, $MogileFS::Server::VERSION; 134 | 135 | } else { 136 | MogileFS::ProcManager->SendHelp($self, $args); 137 | } 138 | 139 | $self->write(join("\r\n", @out) . "\r\n") if @out; 140 | $self->write(".\r\n"); 141 | return; 142 | } 143 | 144 | # Client 145 | sub event_err { my $self = shift; $self->close; } 146 | sub event_hup { my $self = shift; $self->close; } 147 | 148 | # just note that we've died 149 | sub close { 150 | # mark us as being dead 151 | my $self = shift; 152 | MogileFS::ProcManager->NoteDeadClient($self); 153 | $self->SUPER::close(@_); 154 | } 155 | 156 | 1; 157 | 158 | # Local Variables: 159 | # mode: perl 160 | # c-basic-indent: 4 161 | # indent-tabs-mode: nil 162 | # End: 163 | -------------------------------------------------------------------------------- /lib/MogileFS/IOStatWatcher.pm: -------------------------------------------------------------------------------- 1 | package MogileFS::IOStatWatcher; 2 | use strict; 3 | use Sys::Syscall 0.22; # We use it indirectly, and trigger bugs in earlier versions. 4 | use Danga::Socket; 5 | use IO::Socket::INET; 6 | 7 | =head1 Methods 8 | 9 | =head2 $iow = MogileFS::IOStatWatcher->new() 10 | 11 | Returns a new IOStatWatcher object. 12 | 13 | =cut 14 | 15 | sub new { 16 | my ($class) = @_; 17 | my $self = bless { 18 | hosts => {}, 19 | }, $class; 20 | $self->on_stats; # set an empty handler. 21 | return $self; 22 | } 23 | 24 | =head2 $iow->set_hosts( host1 [, host2 [, ...] ] ) 25 | 26 | Sets the list of hosts to connect to for collecting IOStat information. This call can block if you 27 | pass it hostnames instead of ip addresses. 28 | 29 | Upon successful connection, the on_stats callback will be called each time the statistics are 30 | collected. Error states (failed connections, etc.) will trigger retries on 60 second intervals, and 31 | disconnects will trigger an immediate reconnect. 32 | 33 | =cut 34 | 35 | sub set_hosts { 36 | my ($self, @ips) = @_; 37 | my $old_hosts = $self->{hosts}; 38 | my $new_hosts = {}; 39 | foreach my $host (@ips) { 40 | $new_hosts->{$host} = (delete $old_hosts->{$host}) || MogileFS::IOStatWatch::Client->new($host, $self); 41 | } 42 | # TODO: close hosts that were removed (things in %$old_hosts) 43 | $self->{hosts} = $new_hosts; 44 | } 45 | 46 | =head2 $iow->on_stats( coderef ) 47 | 48 | Sets the coderef called for the C callback. 49 | 50 | =cut 51 | 52 | sub on_stats { 53 | my ($self, $cb) = @_; 54 | 55 | unless (ref $cb eq 'CODE') { 56 | $cb = sub {}; 57 | } 58 | 59 | $self->{on_stats} = $cb; 60 | } 61 | 62 | =head1 Callbacks 63 | 64 | =head2 on_stats->( host, stats ) 65 | 66 | Called each time device use statistics are collected. The C 67 | argument is the value passed in to the C method. The 68 | C object is a hashref of mogile device numbers (without leading 69 | "dev") to their corresponding utilization percentages. 70 | 71 | =cut 72 | 73 | # Everything beyond here is internal. 74 | 75 | sub got_stats { 76 | my ($self, $host, $stats) = @_; 77 | $self->{on_stats}->($host, $stats); 78 | } 79 | 80 | sub restart_monitoring_if_needed { 81 | my ($self, $host) = @_; 82 | return unless $self->{hosts}->{$host} && $self->{hosts}->{$host}->{closed}; 83 | $self->{hosts}->{$host} = MogileFS::IOStatWatch::Client->new($host, $self); 84 | } 85 | 86 | sub got_error { 87 | my ($self, $host) = @_; 88 | Danga::Socket->AddTimer(60, sub { 89 | $self->restart_monitoring_if_needed($host); 90 | }); 91 | } 92 | 93 | sub got_disconnect { 94 | my ($self, $host) = @_; 95 | $self->{hosts}->{$host} = MogileFS::IOStatWatch::Client->new($host, $self); 96 | } 97 | 98 | # Support class that does the communication with individual hosts. 99 | package MogileFS::IOStatWatch::Client; 100 | 101 | use strict; 102 | use warnings; 103 | 104 | use base 'Danga::Socket'; 105 | use fields qw(host watcher buffer active); 106 | 107 | sub new { 108 | my MogileFS::IOStatWatch::Client $self = shift; 109 | my $hostspec = shift; 110 | my $watcher = shift; 111 | 112 | my $sock = IO::Socket::INET->new( 113 | PeerAddr => $hostspec, 114 | PeerPort => MogileFS->config("mogstored_stream_port"), 115 | Proto => 'tcp', 116 | Blocking => 0, 117 | ); 118 | return unless $sock; 119 | 120 | $self = fields::new($self) unless ref $self; 121 | $self->SUPER::new($sock); 122 | $self->watch_write(1); 123 | $self->watch_read(1); 124 | 125 | $self->{watcher} = $watcher; 126 | $self->{buffer} = ''; 127 | $self->{host} = $hostspec; 128 | 129 | return $self; 130 | } 131 | 132 | sub event_write { 133 | my MogileFS::IOStatWatch::Client $self = shift; 134 | $self->{active} = 1; 135 | $self->write("watch\n"); 136 | $self->watch_write(0); # I hope I can safely assume that 6 characters will write properly. 137 | } 138 | 139 | sub event_read { 140 | my MogileFS::IOStatWatch::Client $self = shift; 141 | 142 | my $bref = $self->read(10240); 143 | return $self->close unless defined $bref; 144 | 145 | $self->{buffer} .= $$bref; 146 | 147 | if ($self->{buffer} =~ m/^ERR\s+(.*?)\s* $ /x) { 148 | # There was an error on the way to watching this machine, close it and stay quiet. 149 | $self->close; 150 | } 151 | 152 | # If we can yank off lines till there is one by itself with a . on it, we've gotten a full set of stats. 153 | while ($self->{buffer} =~ s/^(.*?\n)?\.\n//s) { 154 | my %stats; 155 | foreach my $line (split /\n+/, $1) { 156 | next unless $line; 157 | my ($devnum, $util) = split /\s+/, $line; 158 | $stats{$devnum} = $util; 159 | } 160 | $self->{watcher}->got_stats($self->{host}, \%stats); 161 | } 162 | } 163 | 164 | sub event_err { 165 | my MogileFS::IOStatWatch::Client $self = shift; 166 | $self->{watcher}->got_error($self->{host}); 167 | } 168 | 169 | sub event_hup { 170 | my MogileFS::IOStatWatch::Client $self = shift; 171 | $self->{watcher}->got_error($self->{host}); 172 | } 173 | 174 | sub close { 175 | my MogileFS::IOStatWatch::Client $self = shift; 176 | if ($self->{active}) { 177 | $self->{watcher}->got_disconnect($self->{host}); 178 | } else { 179 | $self->{watcher}->got_error($self->{host}); 180 | } 181 | $self->SUPER::close(@_); 182 | } 183 | 1; 184 | 185 | -------------------------------------------------------------------------------- /mogdbsetup: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use Getopt::Long; 4 | use lib 'lib'; 5 | use MogileFS::Store; 6 | use MogileFS::Config; 7 | 8 | # Rename binary in process list to make init scripts saner 9 | $0 = $_ = $0; 10 | 11 | my %args = ( 12 | dbhost => "localhost", 13 | dbport => undef, 14 | dbname => "mogilefs", 15 | dbrootuser => undef, 16 | dbrootpass => "", 17 | dbuser => "mogile", 18 | dbpass => "", 19 | ); 20 | 21 | my $opt_help; 22 | my $opt_verbose = 0; 23 | my $opt_yes = 0; 24 | my $opt_noschemabump; 25 | my $dbtype = "MySQL"; 26 | my $plugins; 27 | 28 | usage() 29 | unless GetOptions( 30 | "dbhost=s" => \$args{dbhost}, 31 | "dbport=s" => \$args{dbport}, 32 | "dbname=s" => \$args{dbname}, 33 | "dbrootuser=s" => \$args{dbrootuser}, 34 | "dbrootpassword:s" => \$args{dbrootpass}, 35 | "dbuser=s" => \$args{dbuser}, 36 | "dbpassword:s" => \$args{dbpass}, 37 | "help" => \$opt_help, 38 | "verbose" => \$opt_verbose, 39 | "yes" => \$opt_yes, 40 | "noschemabump" => \$opt_noschemabump, 41 | "type=s" => \$dbtype, 42 | "plugins=s" => \$plugins, 43 | ); 44 | 45 | usage() if $opt_help; 46 | 47 | # Be nice about what the default admin user is called. 48 | if(!defined($args{dbrootuser})) { 49 | $args{dbrootuser} = 'root' if $dbtype =~ /MySQL/i; 50 | $args{dbrootuser} = 'postgres' if $dbtype =~ /Postgres/i; 51 | } 52 | # Saner port management. 53 | # This should default to the UNIX sockets on localhost 54 | if(!defined($args{dbport}) and $args{dbhost} != "localhost" and $args{dbhost} != "127.0.0.1") { 55 | $args{dbport} = '3306' if $dbtype =~ /MySQL/i; 56 | $args{dbport} = '5432' if $dbtype =~ /Postgres/i; 57 | } 58 | 59 | sub usage { 60 | die < Be verbose about what\'s happening. 68 | 69 | --dbhost= localhost hostname or IP to database server. 70 | 71 | --dbport= dbd default port number to database server. 72 | 73 | --dbname= mogilefs database name to create/upgrade. 74 | 75 | --dbrootuser= root Database administrator username. Only needed 76 | for initial setup, not subsequent upgrades. 77 | 78 | --dbrootpass= Database administrator password. Only needed 79 | for initial setup, not subsequent upgrades. 80 | 81 | --dbuser= mogile Regular database user to create and/or use 82 | for MogileFS database. This is what the 83 | mogilefsd trackers connect as. 84 | 85 | --dbpass= You should change this, especially if your 86 | database servers are accessible to other users 87 | on the network. But they shouldn't be 88 | if you're running MogileFS, because MogileFS 89 | assumes your network is closed. 90 | 91 | --type= MySQL Which MogileFS::Store implementation to use. 92 | Available: MySQL, Postgres 93 | 94 | --yes Run without questions. 95 | 96 | USAGE 97 | } 98 | 99 | my $sclass = "MogileFS::Store::$dbtype"; 100 | eval "use $sclass; 1;" or die "Failed to load $sclass: $@"; 101 | 102 | foreach my $plugin (split /\s*,\s*/, $plugins) { 103 | eval "use MogileFS::Plugin::$plugin; 1;" or die "Failed to load plugin $plugin: $@"; 104 | } 105 | 106 | confirm("This will attempt to setup or upgrade your MogileFS database.\nIt won't destroy existing data.\nRun with --help for more information. Run with --yes to shut up these prompts.\n\nContinue?", 0); 107 | 108 | $sclass->on_status(\&status); 109 | $sclass->on_confirm(\&confirm); 110 | 111 | MogileFS::Config->load_config; 112 | 113 | my $sto = $sclass->new_from_mogdbsetup( 114 | map { $_ => $args{$_} } 115 | qw(dbhost dbport dbname 116 | dbrootuser dbrootpass 117 | dbuser dbpass) 118 | ); 119 | my $dbh = $sto->dbh; 120 | 121 | $sto->setup_database 122 | or die "Database upgrade failed.\n"; 123 | 124 | my $latestver = MogileFS::Store->latest_schema_version; 125 | if ($opt_noschemabump) { 126 | warn "\n*\n* Per your request, NOT UPGRADING to $latestver. I assume you understand why.\n*\n"; 127 | } else { 128 | $sto->set_schema_vesion($latestver); 129 | } 130 | 131 | 132 | warn "Done.\n" if $opt_verbose; 133 | exit 0; 134 | 135 | ############################################################################ 136 | 137 | sub confirm { 138 | my $q = shift; 139 | my $def = shift; 140 | $def = 1 unless defined $def; 141 | 142 | return 1 if $opt_yes; 143 | my $deftext = $def ? "[Y/n]" : "[N/y]"; 144 | 145 | print "\n$q $deftext: "; 146 | my $ans = ; 147 | if ($ans =~ /^\s*$/) { 148 | die "Stopped.\n" unless $def; 149 | return 0; 150 | } 151 | return 1 if $ans =~ /^y/i; 152 | die "Stopped.\n"; 153 | } 154 | 155 | sub status { 156 | warn "$_[0]\n" if $opt_verbose; 157 | } 158 | 159 | 160 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Test/WebClient.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | package Perlbal::Test::WebClient; 4 | 5 | use strict; 6 | use IO::Socket::INET; 7 | use Perlbal::Test; 8 | use HTTP::Response; 9 | use Socket qw(MSG_NOSIGNAL IPPROTO_TCP TCP_NODELAY SOL_SOCKET); 10 | 11 | require Exporter; 12 | use vars qw(@ISA @EXPORT $FLAG_NOSIGNAL); 13 | @ISA = qw(Exporter); 14 | @EXPORT = qw(new); 15 | 16 | $FLAG_NOSIGNAL = 0; 17 | eval { $FLAG_NOSIGNAL = MSG_NOSIGNAL; }; 18 | 19 | # create a blank object 20 | sub new { 21 | my $class = shift; 22 | my $self = {}; 23 | bless $self, $class; 24 | return $self; 25 | } 26 | 27 | # get/set what server we should be testing; "ip:port" generally 28 | sub server { 29 | my $self = shift; 30 | if (@_) { 31 | $self->{_sock} = undef; 32 | return $self->{server} = shift; 33 | } else { 34 | return $self->{server}; 35 | } 36 | } 37 | 38 | # get/set what hostname we send with requests 39 | sub host { 40 | my $self = shift; 41 | if (@_) { 42 | $self->{_sock} = undef; 43 | return $self->{host} = shift; 44 | } else { 45 | return $self->{host}; 46 | } 47 | } 48 | 49 | # set which HTTP version to emulate; specify '1.0' or '1.1' 50 | sub http_version { 51 | my $self = shift; 52 | if (@_) { 53 | return $self->{http_version} = shift; 54 | } else { 55 | return $self->{http_version}; 56 | } 57 | } 58 | 59 | # set on or off to enable or disable persistent connection 60 | sub keepalive { 61 | my $self = shift; 62 | if (@_) { 63 | $self->{keepalive} = shift() ? 1 : 0; 64 | } 65 | return $self->{keepalive}; 66 | } 67 | 68 | # construct and send a request 69 | sub request { 70 | my $self = shift; 71 | return undef unless $self->{server}; 72 | 73 | my $opts = ref $_[0] eq "HASH" ? shift : {}; 74 | my $opt_headers = delete $opts->{'headers'}; 75 | my $opt_host = delete $opts->{'host'}; 76 | my $opt_method = delete $opts->{'method'}; 77 | my $opt_content = delete $opts->{'content'}; 78 | my $opt_extra_rn = delete $opts->{'extra_rn'}; 79 | my $opt_return_reader = delete $opts->{'return_reader'}; 80 | my $opt_post_header_pause = delete $opts->{'post_header_pause'}; 81 | die "Bogus options: " . join(", ", keys %$opts) if %$opts; 82 | 83 | my $cmds = join(',', map { eurl($_) } @_); 84 | return undef unless $cmds; 85 | 86 | # keep-alive header if 1.0, also means add content-length header 87 | my $headers = ''; 88 | if ($self->{keepalive}) { 89 | $headers .= "Connection: keep-alive\r\n"; 90 | } else { 91 | $headers .= "Connection: close\r\n"; 92 | } 93 | 94 | if ($opt_headers) { 95 | $headers .= $opt_headers; 96 | } 97 | 98 | if (my $hostname = $opt_host || $self->{host}) { 99 | $headers .= "Host: $hostname\r\n"; 100 | } 101 | my $method = $opt_method || "GET"; 102 | my $body = ""; 103 | 104 | if ($opt_content) { 105 | $headers .= "Content-Length: " . length($opt_content) . "\r\n"; 106 | $body = $opt_content; 107 | } 108 | 109 | if ($opt_extra_rn) { 110 | $body .= "\r\n"; # some browsers on POST send an extra \r\n that's not part of content-length 111 | } 112 | 113 | my $send = "$method /$cmds HTTP/$self->{http_version}\r\n$headers\r\n"; 114 | 115 | unless ($opt_post_header_pause) { 116 | $send .= $body; 117 | } 118 | 119 | my $len = length $send; 120 | 121 | # send setup 122 | my $rv; 123 | my $sock = delete $self->{_sock}; 124 | local $SIG{'PIPE'} = "IGNORE" unless $FLAG_NOSIGNAL; 125 | 126 | ### send it cached 127 | if ($sock) { 128 | $rv = send($sock, $send, $FLAG_NOSIGNAL); 129 | if ($! || ! defined $rv) { 130 | undef $self->{_sock}; 131 | } elsif ($rv != $len) { 132 | return undef; 133 | } 134 | } 135 | 136 | # failing that, send it through a new socket 137 | unless ($rv) { 138 | $self->{_reqdone} = 0; 139 | 140 | $sock = IO::Socket::INET->new( 141 | PeerAddr => $self->{server}, 142 | Timeout => 3, 143 | ) or return undef; 144 | setsockopt($sock, IPPROTO_TCP, TCP_NODELAY, pack("l", 1)) or die "failed to set sockopt: $!\n"; 145 | 146 | $rv = send($sock, $send, $FLAG_NOSIGNAL); 147 | if ($! || $rv != $len) { 148 | return undef; 149 | } 150 | } 151 | 152 | if ($opt_post_header_pause) { 153 | select undef, undef, undef, $opt_post_header_pause; 154 | my $len = length $body; 155 | if ($len) { 156 | my $rv = send($sock, $body, $FLAG_NOSIGNAL); 157 | if ($! || ! defined $rv) { 158 | undef $self->{_sock}; 159 | } elsif ($rv != $len) { 160 | return undef; 161 | } 162 | } 163 | } 164 | 165 | my $parse_it = sub { 166 | my ($resp, $firstline) = resp_from_sock($sock); 167 | 168 | my $conhdr = $resp->header("Connection") || ""; 169 | if (($firstline =~ m!\bHTTP/1\.1\b! && $conhdr !~ m!\bclose\b!i) || 170 | ($firstline =~ m!\bHTTP/1\.0\b! && $conhdr =~ m!\bkeep-alive\b!i)) { 171 | $self->{_sock} = $sock; 172 | $self->{_reqdone}++; 173 | } else { 174 | $self->{_reqdone} = 0; 175 | } 176 | 177 | return $resp; 178 | }; 179 | 180 | if ($opt_return_reader) { 181 | return $parse_it; 182 | } else { 183 | return $parse_it->(); 184 | } 185 | } 186 | 187 | sub reqdone { 188 | my $self = shift; 189 | return $self->{_reqdone}; 190 | } 191 | 192 | # general purpose URL escaping function 193 | sub eurl { 194 | my $a = $_[0]; 195 | $a =~ s/([^a-zA-Z0-9_\,\-.\/\\\: ])/uc sprintf("%%%02x",ord($1))/eg; 196 | $a =~ tr/ /+/; 197 | return $a; 198 | } 199 | 200 | 1; 201 | -------------------------------------------------------------------------------- /lib/mogdeps/Perlbal/Plugin/Stats.pm: -------------------------------------------------------------------------------- 1 | ########################################################################### 2 | # basic Perlbal statistics gatherer 3 | ########################################################################### 4 | 5 | package Perlbal::Plugin::Stats; 6 | 7 | use strict; 8 | use warnings; 9 | no warnings qw(deprecated); 10 | 11 | use Time::HiRes qw(gettimeofday tv_interval); 12 | 13 | # setup our package variables 14 | our %statobjs; # { svc_name => [ service, statobj ], svc_name => [ service, statobj ], ... } 15 | 16 | # define all stats keys here 17 | our @statkeys = qw( files_sent files_reproxied 18 | web_requests proxy_requests 19 | proxy_requests_highpri ); 20 | 21 | # called when we're being added to a service 22 | sub register { 23 | my ($class, $svc) = @_; 24 | 25 | # create a stats object 26 | my $sobj = Perlbal::Plugin::Stats::Storage->new(); 27 | $statobjs{$svc->{name}} = [ $svc, $sobj ]; 28 | 29 | # simple events we count are done here. when the hook on the left side is called, 30 | # we simply increment the count of the stat on the right side. 31 | my %simple = qw( 32 | start_send_file files_sent 33 | start_file_reproxy files_reproxied 34 | start_web_request web_requests 35 | ); 36 | 37 | # create hooks for %simple things 38 | while (my ($hook, $stat) = each %simple) { 39 | eval "\$svc->register_hook('Stats', '$hook', sub { \$sobj->{'$stat'}++; return 0; });"; 40 | return undef if $@; 41 | } 42 | 43 | # more complicated statistics 44 | $svc->register_hook('Stats', 'backend_client_assigned', sub { 45 | my Perlbal::BackendHTTP $be = shift; 46 | my Perlbal::ClientProxy $cp = $be->{client}; 47 | $sobj->{pending}->{"$cp"} = [ gettimeofday() ]; 48 | ($cp->{high_priority} ? $sobj->{proxy_requests_highpri} : $sobj->{proxy_requests})++; 49 | return 0; 50 | }); 51 | $svc->register_hook('Stats', 'backend_response_received', sub { 52 | my Perlbal::BackendHTTP $be = shift; 53 | my Perlbal::ClientProxy $obj = $be->{client}; 54 | my $ot = delete $sobj->{pending}->{"$obj"}; 55 | return 0 unless defined $ot; 56 | 57 | # now construct data to put in recent 58 | if (defined $obj->{req_headers}) { 59 | my $uri = 'http://' . ($obj->{req_headers}->header('Host') || 'unknown') . $obj->{req_headers}->request_uri; 60 | push @{$sobj->{recent}}, sprintf('%-6.4f %s', tv_interval($ot), $uri); 61 | shift(@{$sobj->{recent}}) if scalar(@{$sobj->{recent}}) > 100; # if > 100 items, lose one 62 | } 63 | return 0; 64 | }); 65 | 66 | return 1; 67 | } 68 | 69 | # called when we're no longer active on a service 70 | sub unregister { 71 | my ($class, $svc) = @_; 72 | 73 | # clean up time 74 | $svc->unregister_hooks('Stats'); 75 | delete $statobjs{$svc->{name}}; 76 | return 1; 77 | } 78 | 79 | # called when we are loaded 80 | sub load { 81 | # setup a management command to dump statistics 82 | Perlbal::register_global_hook("manage_command.stats", sub { 83 | my @res; 84 | 85 | # create temporary object for stats storage 86 | my $gsobj = Perlbal::Plugin::Stats::Storage->new(); 87 | 88 | # dump per service 89 | foreach my $svc (keys %statobjs) { 90 | my $sobj = $statobjs{$svc}->[1]; 91 | 92 | # for now, simply dump the numbers we have 93 | foreach my $key (sort @statkeys) { 94 | push @res, sprintf("%-15s %-25s %12d", $svc, $key, $sobj->{$key}); 95 | $gsobj->{$key} += $sobj->{$key}; 96 | } 97 | } 98 | 99 | # global stats 100 | foreach my $key (sort @statkeys) { 101 | push @res, sprintf("%-15s %-25s %12d", 'total', $key, $gsobj->{$key}); 102 | } 103 | 104 | push @res, "."; 105 | return \@res; 106 | }); 107 | 108 | # recent requests and how long they took 109 | Perlbal::register_global_hook("manage_command.recent", sub { 110 | my @res; 111 | foreach my $svc (keys %statobjs) { 112 | my $sobj = $statobjs{$svc}->[1]; 113 | push @res, "$svc $_" 114 | foreach @{$sobj->{recent}}; 115 | } 116 | 117 | push @res, "."; 118 | return \@res; 119 | }); 120 | 121 | return 1; 122 | } 123 | 124 | # called for a global unload 125 | sub unload { 126 | # unregister our global hooks 127 | Perlbal::unregister_global_hook('manage_command.stats'); 128 | Perlbal::unregister_global_hook('manage_command.recent'); 129 | 130 | # take out all service stuff 131 | foreach my $statref (values %statobjs) { 132 | $statref->[0]->unregister_hooks('Stats'); 133 | } 134 | %statobjs = (); 135 | 136 | return 1; 137 | } 138 | 139 | # statistics storage object 140 | package Perlbal::Plugin::Stats::Storage; 141 | 142 | use fields ( 143 | 'files_sent', # files sent from disk (includes reproxies and regular web requests) 144 | 'files_reproxied', # files we've sent via reproxying (told to by backend) 145 | 'web_requests', # requests we sent ourselves (no reproxy, no backend) 146 | 'proxy_requests', # regular requests that went to a backend to be served 147 | 'proxy_requests_highpri', # same as above, except high priority 148 | 149 | 'pending', # hashref; { "obj" => time_start } 150 | 'recent', # arrayref; strings of recent URIs and times 151 | ); 152 | 153 | sub new { 154 | my Perlbal::Plugin::Stats::Storage $self = shift; 155 | $self = fields::new($self) unless ref $self; 156 | 157 | # 0 initialize everything here 158 | $self->{$_} = 0 foreach @Perlbal::Plugin::Stats::statkeys; 159 | 160 | # other setup 161 | $self->{pending} = {}; 162 | $self->{recent} = []; 163 | 164 | return $self; 165 | } 166 | 167 | 1; 168 | -------------------------------------------------------------------------------- /lib/Mogstored/ChildProcess/IOStat.pm: -------------------------------------------------------------------------------- 1 | package Mogstored::ChildProcess::IOStat; 2 | use strict; 3 | use base 'Mogstored::ChildProcess'; 4 | 5 | my $docroot; 6 | 7 | sub pre_exec_init { 8 | my $class = shift; 9 | 10 | close STDIN; 11 | close STDOUT; 12 | close STDERR; 13 | 14 | my $iostat_pipe_w = Mogstored->get_iostat_writer_pipe; 15 | 16 | # We may not be able to see errors beyond this point 17 | open STDIN, '<', '/dev/null' or die "Couldn't open STDIN for reading from /dev/null"; 18 | open STDOUT, '>&', $iostat_pipe_w or die "Couldn't dup pipe for use as STDOUT"; 19 | open STDERR, '>', '/dev/null' or die "Couldn't open STDOUT for writing to /dev/null"; 20 | 21 | $ENV{MOG_DOCROOT} = Perlbal->service('mogstored')->{docroot}; 22 | } 23 | 24 | sub run { 25 | $docroot = $ENV{MOG_DOCROOT}; 26 | die "\$ENV{MOG_DOCROOT} not set" unless $docroot; 27 | die "\$ENV{MOG_DOCROOT} not set to a directory" unless -d $docroot; 28 | 29 | # (runs in exec'd child process) 30 | $0 = "mogstored [iostat]"; 31 | select((select(STDOUT), $|++)[0]); 32 | 33 | my $iostat_pid; 34 | $SIG{TERM} = $SIG{INT} = sub { 35 | kill 9, $iostat_pid if $iostat_pid; 36 | exit(0); 37 | }; 38 | 39 | my $check_for_parent = sub { 40 | # shut ourselves down if our parent mogstored 41 | # has gone away. 42 | my $ppid = getppid(); 43 | unless ($ppid && kill(0,$ppid)) { 44 | kill 9, $iostat_pid if $iostat_pid; 45 | exit(0); 46 | } 47 | }; 48 | 49 | my $get_iostat_fh = sub { 50 | while (1) { 51 | if ($iostat_pid = open (my $fh, "iostat -dx 1 30|")) { 52 | return $fh; 53 | } 54 | # TODO: try and find other paths to iostat 55 | $check_for_parent->(); 56 | warn "Failed to open iostat: $!\n"; # this will just go to /dev/null, but will be straceable 57 | sleep 10; 58 | } 59 | }; 60 | 61 | while (1) { 62 | my $iofh = $get_iostat_fh->(); 63 | my $mog_sysid = mog_sysid_map(); # 5 (mogdevid) -> 2340 (os devid) 64 | my $dev_sysid = {}; # hashref, populated lazily: { /dev/sdg => system dev_t } 65 | my %devt_util; # dev_t => 52.55 66 | my $init = 0; 67 | while (<$iofh>) { 68 | if (m/^Device:/) { 69 | %devt_util = (); 70 | $init = 1; 71 | next; 72 | } 73 | next unless $init; 74 | if (m/^ (\S+) .*? ([\d.]+) \n/x) { 75 | my ($devnode, $util) = ("/dev/$1", $2); 76 | unless (exists $dev_sysid->{$devnode}) { 77 | $dev_sysid->{$devnode} = (stat($devnode))[6]; # rdev 78 | } 79 | my $devt = $dev_sysid->{$devnode}; 80 | $devt_util{$devt} = $util; 81 | next; 82 | } 83 | # blank line is the end. 84 | if (m!^\s*\n!) { 85 | $init = 0; 86 | my $ret = ""; 87 | foreach my $mogdevid (sort { $a <=> $b } keys %$mog_sysid) { 88 | my $devt = $mog_sysid->{$mogdevid}; 89 | my $ut = defined $devt_util{$devt} ? $devt_util{$devt} : "-"; 90 | $ret .= "$mogdevid\t$ut\n"; 91 | } 92 | $ret .= ".\n"; 93 | print $ret; 94 | 95 | $check_for_parent->(); 96 | next; 97 | } 98 | } 99 | } 100 | 101 | } 102 | 103 | # returns hashref of { 5 => dev_t device } # mog_devid -> os_devid 104 | sub mog_sysid_map { 105 | my $path = $docroot; 106 | $path =~ s!/$!!; 107 | 108 | # find all devices below us 109 | my @devnum; # integer ids 110 | opendir(my $d, $path) or die "Failed to open docroot: $path: $!"; 111 | @devnum = map { /^dev(\d+)$/ ? $1 : () } readdir($d); 112 | 113 | my $map = {}; 114 | foreach my $mogdevid (@devnum) { 115 | my ($osdevid) = (stat("$path/dev$mogdevid"))[0]; 116 | $map->{$mogdevid} = $osdevid; 117 | } 118 | 119 | if (lc($^O) eq 'linux') { 120 | # name_to_number and number_to_name are the data derived from /proc/partitions 121 | my %name_to_number; # ( hda1 => 769, ... ) 122 | my %number_to_name; # ( 769 => hda1, ... ) 123 | 124 | if (open my $partitions, '<', '/proc/partitions') { 125 | <$partitions>; <$partitions>; # First two lines are for humans 126 | while (my $line = <$partitions>) { 127 | next unless $line =~ m/^ \s* (\d+) \s+ (\d+) \s+ \d+ \s+ (\S+) \s* $/x; 128 | my ($major, $minor, $devname) = ($1, $2, $3); 129 | my $devno = ($major << 8) + $minor; 130 | $name_to_number{$devname} = $devno; 131 | $number_to_name{$devno} = $devname; 132 | } 133 | } else { 134 | warn "Unable to open /proc/partitions: $!"; 135 | } 136 | 137 | # Iterate over the hash { 1 => 768 } meaning (mogile device dev1 points to os device 768) 138 | foreach my $mogdevid (keys %$map) { 139 | # Look up the original device number 140 | my $original = $map->{$mogdevid}; 141 | 142 | # See if there is a mapping to turn it into a device name (eg. hda1) 143 | my $devname = $number_to_name{$original} or next; 144 | 145 | # Pull off the new device name with a regex 146 | if (my ($newname) = $devname =~ m/^([hs]d\w+)\d+$/) { 147 | # Skip if we can't map it back to a device number 148 | my $newnum = $name_to_number{$newname} or next; 149 | $map->{$mogdevid} = $newnum; 150 | } elsif (my ($newname, undef) = $devname =~ m/^(cciss\/c\d+d\d+)(\w+)?$/) { 151 | my $newnum = $name_to_number{$newname} or next; 152 | $map->{$mogdevid} = $newnum; 153 | } 154 | } 155 | } 156 | return $map; 157 | } 158 | 159 | 1; 160 | --------------------------------------------------------------------------------