#!/usr/bin/perl
#
# MogileFS daemon - HEAVILY UNDER CONSTRUCTION
#
# Copyright 2004, Danga Interactive
#
# Authors:
#   Brad Fitzpatrick <brad@danga.com>
#   Brad Whitaker    <whitaker@danga.com>
#   Mark Smith       <junior@danga.com>
#
# License:
#   undecided.
#

package Mgd;

# don't run as root
die "mogilefsd cannot be run as root\n"
    if $< == 0;

use strict;
use Getopt::Long;
use IO::Socket;
use Symbol;
use POSIX ":sys_wait_h"; # argument for waitpid
use POSIX;
use DBI;
use DBD::mysql;
use File::Copy ();
use Carp;
use File::Basename ();
use File::Path ();
use Sys::Syslog;
use Socket qw(MSG_NOSIGNAL);
use Time::HiRes qw(gettimeofday tv_interval);
use Net::Netmask;
use LWP::UserAgent;


#####################################################################
### C O N F I G
#####################################################################

use vars qw($dbh $DEFAULT_CONFIG $DEFAULT_MOG_ROOT $MOG_ROOT $MOGSTORED_STREAM_PORT $DEBUG $USE_HTTP $FLAG_NOSIGNAL);

$DEFAULT_CONFIG = "/etc/mogilefs/mogilefsd.conf";
$DEFAULT_MOG_ROOT = "/mnt/mogilefs";
$MOGSTORED_STREAM_PORT = 7501;
$DEBUG = 0;

# used in send() calls to request not to get SIGPIPEd
eval { $FLAG_NOSIGNAL = MSG_NOSIGNAL };

my (
    %cmdline,
    %cfgfile,
    $config,
    $skipconfig,
    $daemonize,
    $db_dsn,
    $db_user,
    $db_pass,
    $conf_port,
    $query_jobs,
    $delete_jobs,
    $replicate_jobs,
    $reaper_jobs,
    $monitor_jobs,
    $mog_root,
    $default_mindevcount,
    $worker_port,
    $upgrade,
    $min_free_space,
    $max_disk_age,
    $node_timeout,          # time in seconds to wait for storage node responses
   );

# Command-line options will override
Getopt::Long::Configure( "bundling" );
Getopt::Long::GetOptions(
    'c|config=s'    => \$config,
    's|skipconfig'  => \$skipconfig,
    'd|debug+'      => \$cmdline{debug},
    'D|daemon'      => \$cmdline{daemonize},
    'dsn=s'         => \$cmdline{db_dsn},
    'dbuser=s'      => \$cmdline{db_user},
    'dbpass=s'      => \$cmdline{db_pass},
    'r|mogroot=s'   => \$cmdline{mog_root},
    'p|confport=i'  => \$cmdline{conf_port},
    'w|workers=i'   => \$cmdline{query_jobs},
    'no_http'       => \$cmdline{no_http},
    'workerport=i'  => \$cmdline{worker_port},
    'upgrade'       => \$upgrade,
    'maxdiskage=i'  => \$cmdline{max_disk_age},
    'minfreespace=i' => \$cmdline{min_free_space},
    'default_mindevcount=i' => \$cmdline{default_mindevcount},
    'node_timeout=i' => \$cmdline{node_timeout},
);

$config = $DEFAULT_CONFIG if !$config && -r $DEFAULT_CONFIG;

# Read the config file if one was specified
if ( $config && !$skipconfig ) {
    open my $cf, "<$config" or die "open: $config: $!";

    my $configLine = qr{
        ^\s*                    # Leading space
        (\w+)                   # Key
        \s+ =? \s*              # space + optional equal + optional space
        (.+?)                   # Value
        \s*$                    # Trailing space
    }x;

    my $linecount = 0;
    while (defined( my $line = <$cf> )) {
        $linecount++;
        next if $line =~ m{^\s*(#.*)?$};
        die "Malformed config file (line $linecount)" unless $line =~ $configLine;

        my ( $key, $value ) = ( $1, $2 );
        print STDERR "Setting '$key' to '$value'\n" if $cmdline{debug};
        $cfgfile{ $key } = $value;
    }

    close $cf;
}

### FUNCTION: choose_value( $name, $default[, $boolean] )
sub choose_value ($$;$) {
    my ( $name, $default, $boolean ) = @_;

    return $cmdline{$name} if defined $cmdline{$name};
    return $cfgfile{$name} if defined $cfgfile{$name};
    return $default;
}


# Fill in defaults for those values which were either loaded from config or
# specified on the command line. Command line takes precendence, then values in
# the config file, then the defaults.
$daemonize      = choose_value( 'daemonize', 0, 1 );
$db_dsn         = choose_value( 'db_dsn', "DBI:mysql:mogilefs" );
$db_user        = choose_value( 'db_user', "mogile" );
$db_pass        = choose_value( 'db_pass', "", 1 );
$conf_port      = choose_value( 'conf_port', 7001 );
$MOG_ROOT       = choose_value( 'mog_root', $DEFAULT_MOG_ROOT );
$query_jobs     = choose_value( 'listener_jobs', undef) || # undef if not present, then we
                  choose_value( 'query_jobs', 20 );       # fall back to query_jobs, new name
$delete_jobs    = choose_value( 'delete_jobs', 1 );
$replicate_jobs = choose_value( 'replicate_jobs', 1 );
$reaper_jobs    = choose_value( 'reaper_jobs', 1 );
$monitor_jobs   = choose_value( 'monitor_jobs', 1 );
$worker_port    = choose_value( 'worker_port', 7200 );
$min_free_space = choose_value( 'min_free_space', 100 );
$max_disk_age   = choose_value( 'max_disk_age', 5 );
$DEBUG          = choose_value( 'debug', 0, 1 );
$USE_HTTP       = ! choose_value( 'no_http', 0, 1);
$default_mindevcount = choose_value( 'default_mindevcount', 2 );
$node_timeout   = choose_value( 'node_timeout', 3 );

### initial setup
Mgd::validate_dbh();
my $dbh = Mgd::get_dbh();
unless ($dbh) {
    die <<NODB;
Error: unable to establish connection with your MogileFS database.

Please verify that you have correctly setup a configuration file or are
providing the correct information in order to reach the database and try
running the MogileFS server again.
NODB
}

### make sure they have a database setup?
my $host = $dbh->selectrow_hashref('SELECT * FROM host LIMIT 1');
if ($dbh->err) {
    my $err = $dbh->errstr;
    my $db = ($db_dsn =~ /^DBI:mysql:(.+)$/) ? $1 : '<db_name>';
    die <<ERR;
Database error: $err

This is commonly caused by not having the tables created in the database.
The easiest way to setup your database is to do something like this:

    cat devnotes/sql.txt | mysql -u$db_user -p $db

NOTE: This will OVERWRITE any MogileFS related tablase in the database.
Please make SURE that this is what you want to do before you do this!
ERR
}

### but if it was undef, no hosts?
if ($host) {
    # see if they have the get port, else update it
    unless (exists $host->{http_get_port}) {
        if ($upgrade) {
            print STDERR "Updating host table...\n";
            $dbh->do("ALTER TABLE host ADD COLUMN http_get_port MEDIUMINT UNSIGNED AFTER http_port");
            die "Error: " . $dbh->errstr . "\n" if $dbh->err;
        } else {
            die <<NEEDUPDATE;
Error: host table out of date.

MogileFS needs to update your database schema.  Please rerun the MogileFS
server with the --upgrade option if you wish for us to do this.

This will NOT destroy any existing data.
NEEDUPDATE
        }
    }

    # now update to add new columns?
    unless (exists $host->{altip}) {
        if ($upgrade) {
            print STDERR "Updating host table...\n";
            $dbh->do("ALTER TABLE host ADD COLUMN altip VARCHAR(15) AFTER hostip");
            die "Error (1): " . $dbh->errstr . "\n" if $dbh->err;
            $dbh->do("ALTER TABLE host ADD COLUMN altmask VARCHAR(18) AFTER altip");
            die "Error (2): " . $dbh->errstr . "\n" if $dbh->err;
            $dbh->do("ALTER TABLE host ADD UNIQUE altip (altip)");
            die "Error (3): " . $dbh->errstr . "\n" if $dbh->err;
        } else {
            die <<NEEDUPDATE;
Error: host table out of date.

MogileFS needs to update your database schema.  Please rerun the MogileFS
server with the --upgrade option if you wish for us to do this.

This will NOT destroy any existing data.
NEEDUPDATE
        }
    }
} else {
    die <<NOHOSTS;
Error: no hosts found.

It seems like you don't have any hosts defined in your MogileFS setup.
This means that we really can't do anything, so we're going to shut down.
NOHOSTS
}

### and now check for devices
my $device = $dbh->selectrow_hashref('SELECT * FROM device LIMIT 1');
if ($device) {
    unless (exists $device->{mb_asof}) {
        if ($upgrade) {
            print STDERR "Updating device table...\n";
            $dbh->do("ALTER TABLE device ADD COLUMN mb_asof INT(10) UNSIGNED AFTER mb_used");
            die "Error: " . $dbh->errstr . "\n" if $dbh->err;
        } else {
            die <<NEEDUPDATE;
Error: device table out of date.

MogileFS needs to update your database schema.  Please rerun the MogileFS
server with the --upgrade option if you wish for us to do this.

This will NOT destroy any existing data.
NEEDUPDATE
        }
    }
} else {
    die <<NODEVICES;
Error: no devices found.

It seems like you don't have any devices defined in your MogileFS setup.
This means that we really can't do anything, so we're going to shut down.
NODEVICES
}

# see if they have the new fid table
my $fid = $dbh->selectrow_array('SELECT fid FROM unreachable_fids LIMIT 1');
if ($dbh->err) {
    if ($upgrade) {
        print STDERR "Creating unreachable_fids table...\n";
        $dbh->do("CREATE TABLE unreachable_fids (" .
                 "    fid        INT UNSIGNED NOT NULL," .
                 "    lastupdate INT UNSIGNED NOT NULL," .
                 "    PRIMARY KEY (fid)," .
                 "    INDEX (lastupdate)" .
                 ")");
        die "Error: " . $dbh->errstr . "\n" if $dbh->err;
    } else {
        die <<NEEDUPDATE;
Error: database schema out of date.

MogileFS needs to update your database schema.  Please rerun the MogileFS
server with the --upgrade option if you wish for us to do this.

This will NOT destroy any existing data.
NEEDUPDATE

    }
}

# now check for an updated tempfile table
my $devids = $dbh->selectrow_array('SELECT devids FROM tempfile LIMIT 1');
if ($dbh->err) {
    if ($upgrade) {
        print STDERR "Updating tempfile table...\n";
        $dbh->do("ALTER TABLE tempfile ADD COLUMN devids VARCHAR(60)");
        die "Error: " . $dbh->errstr . "\n" if $dbh->err;
    } else {
        die <<NEEDUPDATE;
Error: database schema out of date.

MogileFS needs to update your database schema.  Please rerun the MogileFS
server with the --upgrade option if you wish for us to do this.

This will NOT destroy any existing data.
NEEDUPDATE
    }
}

# we're done with this, so undef it before we start forking, as then
# maybe we'll end up with children having the same socket and everybody
# writing to it at the same time...
undef $dbh;

#####################################################################
### D A E M O N   F U N C T I O N S
#####################################################################

daemonize() if $daemonize;

# keep track of what all child pids are doing, and what jobs are being
# satisifed.
my %child  = ();    # pid -> job
my %todie  = ();    # pid -> 1 (lists pids that we've asked to die)
my %jobs   = ();    # jobname -> [ min, current ]
my $psock;          # IO::Socket::INET connection to parent (undef if parent)
my %streamcache;    # host -> IO::Socket::INET to mogstored
my $lastspawntime = 0; # time we last ran spawn_children sub
our $allkidsup = 0;  # if true, all our kids are running. set to 0 when a kid dies.
our $starttime = time; # time we got going
our %domaincache; # { domainname => { domainrow } }
our $domaincachetime = 0;
our $client_ip = undef; # client ip address
our $force_alt_zone = 0; # if on, force to use alternate zone (if it's defined)

# [ what we want to be at, what we are at ]
$jobs{'queryworker'} = [ $query_jobs, 0 ];
$jobs{'delete'} = [ $delete_jobs, 0 ];
$jobs{'replicate'} = [ $replicate_jobs, 0 ];
$jobs{'reaper'} = [ $reaper_jobs, 0 ];
$jobs{'monitor'} = [ $monitor_jobs, 0 ];

# open up our log
openlog('mogilefsd', 'pid', 'daemon');
Mgd::log('info', 'beginning run');

sub validate_dbh {
    return unless $dbh;
    my $id = $dbh->selectrow_array("SELECT CONNECTION_ID()");
    if (! $id) {
        # handle's dead.  don't use it.  (MySQL-ism above)
        undef $dbh;
    }
}

sub get_dbh {
    return $dbh ||= DBI->connect($db_dsn, $db_user, $db_pass);
}

# Install signal handlers.
$SIG{TERM}  = sub {
    print STDERR scalar keys %child, " children to kill.\n" if $DEBUG;
    my $count = kill( 'TERM' => keys %child );
    print STDERR "Sent SIGTERM to $count children.\n" if $DEBUG;
    exit 0;
};
$SIG{INT}  = sub {
    print STDERR scalar keys %child, " children to kill.\n" if $DEBUG;
    my $count = kill( 'INT' => keys %child );
    print STDERR "Sent SIGINT to $count children.\n" if $DEBUG;
    exit 0;
};

#############################################################################
## beginning of main execution path
#############################################################################

# setup server socket to listen for client connections
my $server = IO::Socket::INET->new(LocalPort => $conf_port,
                                   Type      => SOCK_STREAM,
                                   Proto     => 'tcp',
                                   Blocking  => 0,
                                   Reuse     => 1,
                                   Listen    => 10 )
    or die "Error creating socket: $@\n";

# accept handler for new clients
my $accept_handler = sub {
    my $csock = $server->accept();
    return unless $csock;

    printf( "Listen child making a Client for %d.\n", fileno($csock) )
        if $DEBUG >= 2;
    my $client = Client->new($csock);
    printf( "Client is %s\n", $client ) if $DEBUG >= 2;
    $client->watch_read(1);
};

# now setup socket for workers to connect to
my $wserver = IO::Socket::INET->new(LocalPort => $worker_port,
                                    LocalAddr => '127.0.0.1',
                                    Type      => SOCK_STREAM,
                                    Proto     => 'tcp',
                                    Blocking  => 0,
                                    Reuse     => 1,
                                    Listen    => 10 )
    or die "Error creating socket: $@\n";

# accept handler for new workers
my $waccept_handler = sub {
    my $csock = $wserver->accept();
    return unless $csock;

    printf( "Listen child making a Client for %d.\n", fileno($csock) )
        if $DEBUG >= 2;
    my $client = WorkerConn->new($csock);
    printf( "Child is %s\n", $client ) if $DEBUG >= 2;
    Frontend->RegisterWorkerConn($client);
};

# thing to keep jobs alive
my $spawn_children = sub {
    # run only once per second
    return 1 unless time > $lastspawntime;
    $lastspawntime = time();

    # see if anybody has died, but don't hang up on doing so
    my $pid = waitpid -1, WNOHANG;
    return 1 if $pid <= 0 && $allkidsup;
    $allkidsup = 0; # know something died

    # when a child dies, figure out what it was doing
    # and note that job has one less worker
    my $job;
    if ($pid > -1 && ($job = delete $child{$pid})) {
        my $extra = $todie{$pid} ? "expected" : "UNEXPECTED";
        error("Child $pid ($job) died: $? ($extra)");
        Frontend->NoteDeadChild($pid);

        if (my $jobstat = $jobs{$job}) {
            # if the pid is in %todie, then we have asked it to shut down
            # and have already decremented the jobstat counter and don't
            # want to do it again
            unless (my $true = delete $todie{$pid}) {
                # decrement the count of currently running jobs
                $jobstat->[1]--;
            }
        }
    }

    # foreach job, fork enough children
    while (my ($job, $jobstat) = each %jobs) {
        my $need = $jobstat->[0] - $jobstat->[1];
        if ($need > 0) {
            error("Job $job has only $jobstat->[1], wants $jobstat->[0], making $need.");
            for (1..$need) {
                my $cpid = make_new_child($job);
                return 1 unless $cpid;
                $child{$cpid} = $job;

                # now increase the count of processes currently doing this job
                $jobstat->[1]++;
            }
        }
    }

    # if we got this far, all jobs have been re-created.  note that
    # so we avoid more CPU usage in this post-event-loop callback later
    $allkidsup = 1;

    # true value keeps us running:
    return 1;
};

# setup Danga::Socket to start handling connections
Client->DebugLevel( 3 );
Client->OtherFds( fileno($server)  => $accept_handler,
                  fileno($wserver) => $waccept_handler, );

# setup the post event loop callback to spawn jobs, and the timeout
Client->SetLoopTimeout( 250 ); # 250 milliseconds
Client->SetPostLoopCallback($spawn_children);

# and now, actually start listening for events
eval {
    print( "Starting event loop for frontend job on pid $$.\n" ) if $DEBUG;
    Client->EventLoop();
};

if ( $@ ) { Mgd::log('err', "crash log: $@"); }
Mgd::log('info', 'ending run');
closelog();

#############################################################################
## end of main
#############################################################################

sub daemonize {
    my($pid, $sess_id, $i);

    ## Fork and exit parent
    if ($pid = fork) { exit 0; }

    ## Detach ourselves from the terminal
    croak "Cannot detach from controlling terminal"
        unless $sess_id = POSIX::setsid();

    ## Prevent possibility of acquiring a controling terminal
    $SIG{'HUP'} = 'IGNORE';
    if ($pid = fork) { exit 0; }

    ## Change working directory
    chdir "/";

    ## Clear file creation mask
    umask 0;

    print STDERR "Daemon running as pid $$.\n" if $DEBUG;

    ## Close open file descriptors
    close(STDIN);
    close(STDOUT);
    close(STDERR);

    ## Reopen stderr, stdout, stdin to /dev/null
    if ( $DEBUG ) {
        open(STDIN,  "+>/tmp/mogilefsd.log");
    } else {
        open(STDIN,  "+>/dev/null");
    }
    open(STDOUT, "+>&STDIN");
    open(STDERR, "+>&STDIN");
}

sub make_new_child {
    my $job = shift;

    my $pid;
    my $sigset;

    # block signal for fork
    $sigset = POSIX::SigSet->new(SIGINT);
    sigprocmask(SIG_BLOCK, $sigset)
        or return error("Can't block SIGINT for fork: $!");

    return error("fork failed creating $job: $!")
        unless defined ($pid = fork);

    if ($pid) {
        sigprocmask(SIG_UNBLOCK, $sigset)
            or return error("Can't unblock SIGINT for fork: $!");
        return $pid;
    }

    # as a child, we want to close these and ignore them
    close($server);
    close($wserver);

    $SIG{INT} = 'DEFAULT';
    $SIG{TERM} = 'DEFAULT';
    $0 .= " [$job]";

    # unblock signals
    sigprocmask(SIG_UNBLOCK, $sigset)
        or return error("Can't unblock SIGINT for fork: $!");

    # set our frontend into child mode
    Frontend->SetAsChild;

    # try to create a connection to the parent.  we die here because
    # we're the child and if we can't talk to the master we really need
    # to die so that a child isn't just sitting around without communication
    # to the parent.
    $psock = IO::Socket::INET->new(PeerAddr => "127.0.0.1",
                                   PeerPort => $worker_port,
                                   Type     => SOCK_STREAM,
                                   Proto    => 'tcp',)
        or die "Error creating socket to master: $@\n";
    $psock->write("$$ $job\n");

    # now call our job function
    no strict 'refs';
    my $job_handler = *{"job_$job"}{CODE};
    $job_handler->();
    exit;
}

# given (job, pid), record that this worker is about to die
sub note_pending_death {
    my ($job, $pid) = @_;

    die "$job not defined in call to note_pending_death.\n"
        unless defined $jobs{$job};

    $todie{$pid} = 1;
    $jobs{$job}->[1]--;
}

# log stuff to syslog or the screen
sub log {
    # simple logging functionality
    if (! $daemonize) {
        # syslog acts like printf so we have to use printf and append a \n
        shift; # ignore the first parameter (info, warn, critical, etc)
        printf(shift(@_) . "\n", @_);
    } else {
        # just pass the parameters to syslog
        syslog(@_);
    }
}

# argument: a string to send to the parent process.
sub send_to_parent {
    # send a string to our parent
    return unless $psock;
    $psock->write("$_[0]\r\n");
}

# argument: a string to take as indicating the error that just happened.
sub error {
    if ($psock) {
        # we're a child, pass error to parent
        send_to_parent("error $_[0]");
    } else {
        # we're a parent, so just handle output of error
        Frontend->NoteError(\$_[0]);
        Mgd::log('debug', $_[0]);
    }
    return 0;
}

sub job_delete {

  PASS:
    while (1) {
        sleep 9;
        validate_dbh();
        my $dbh = get_dbh();

        # see if we have anything from the parent
        send_to_parent('del_i_looped');
        while (defined (my $line = <$psock>)) {
            $line =~ s/\r?\n$//;
            last if $line eq '.';
            if ($line eq 'shutdown') {
                exit 0;
            }
        }

        my $LIMIT = 500;
        while (1) {
            sleep 1;
            my $delmap = $dbh->selectall_arrayref("SELECT fd.fid, fo.devid ".
                                                  "FROM file_to_delete fd ".
                                                  "LEFT JOIN file_on fo ON fd.fid=fo.fid ".
                                                  "LIMIT $LIMIT");
            my $count = $delmap ? scalar @$delmap : 0;
            next PASS unless $count;

            my %done;  # fid -> 1 (when fid is deleted from all devices)
            my %dev_down;  # devid -> 1 (when device times out due to EIO)

            foreach my $dm (@$delmap) {
                my ($fid, $devid) = @$dm;

                # if no device is returned from the query above, that
                # means there are no file_on rows for it, and we can consider
                # it now deleted.
                unless ($devid) {
                    $done{$fid} = 1;
                    next;
                }

                # don't try to delete from this device if we earlier
                # found it to be timing out with EIO
                next if $dev_down{$devid};

                my $path = make_path($devid, $fid);
                my $rv = 0;
                if (my $urlref = Mgd::is_url($path)) {
                    # hit up the server and delete it
                    my $sock = IO::Socket::INET->new(PeerAddr => $urlref->[0],
                                                     PeerPort => $urlref->[1],
                                                     Timeout => 2);
                    unless ($sock) {
                        # timeout or something, mark this device as down for now and move on
                        $dev_down{$devid} = 1;
                        next;
                    }

                    # send delete request
                    error("Sending delete for $path") if $Mgd::DEBUG >= 2;
                    $sock->write("DELETE $urlref->[2] HTTP/1.0\r\n\r\n");
                    my $response = <$sock>;
                    if ($response =~ m!^HTTP/\d+\.\d+\s+(\d+)!) {
                        if (($1 >= 200 && $1 <= 299) || $1 == 404) {
                            # effectively means all went well
                            $rv = 1;
                        } else {
                            # remote file system error?  mark node as down
                            error("Error: unlink failure: $path: $1");
                            $dev_down{$devid} = 1;
                            next;
                        }
                    } else {
                        error("Error: unknown response line: $response");
                    }
                } else {
                    # do normal unlink
                    $rv = unlink "$Mgd::MOG_ROOT/$path";

                    # device is timing out.  take note of it and
                    # continue dealing with other deletes
                    if (! $rv) {
                        if ($! == EIO) {
                            $dev_down{$devid} = 1;
                            next;
                        } elsif ($! == ENOENT) {
                            $rv = 1;  # count non-existent file as deleted
                        }
                    }
                }

                # if we deleted it, or it didn't exist, consider it
                # deleted.
                $dbh->do("DELETE FROM file_on WHERE fid=? AND devid=?",
                         undef, $fid, $devid) if $rv;
            }

            if (%done) {
                my $in = join(',', keys %done);
                $dbh->do("DELETE FROM file_to_delete WHERE fid IN ($in)");
            }

            next PASS if $count < $LIMIT;
        }

    }
}

# copies a file from one Perlbal to another utilizing HTTP
sub http_copy {
    my ($sdevid, $ddevid, $fid) = @_;

    # handles setting unreachable magic; $error->(reachability, "message")
    my $error = sub {
        if ($_[0]) {
            send_to_parent("repl_unreachable $fid");

            # update database table
            Mgd::validate_dbh();
            my $dbh = Mgd::get_dbh();
            $dbh->do("REPLACE INTO unreachable_fids VALUES ($fid, UNIX_TIMESTAMP())");
        }
        return error($_[1]);
    };

    # get some information we'll need
    my $devs = Mgd::get_device_summary();
    my ($sdev, $ddev) = ($devs->{$sdevid}, $devs->{$ddevid});
    return error("Error: unable to get device information: source=$sdevid, destination=$ddevid, fid=$fid")
        unless ref $sdev && ref $ddev;
    my ($spath, $dpath) = (Mgd::make_http_path($sdevid, $fid),
                           Mgd::make_http_path($ddevid, $fid));
    my ($shost, $sport) = (Mgd::hostid_ip($sdev->{hostid}), Mgd::hostid_http_port($sdev->{hostid}));
    my ($dhost, $dport) = (Mgd::hostid_ip($ddev->{hostid}), Mgd::hostid_http_port($ddev->{hostid}));
    unless (defined $spath && defined $dpath && defined $shost && defined $dhost && $sport && $dport) {
        # show detailed information to find out what's not configured right
        error("Error: unable to replicate file fid=$fid from device id $sdevid to device id $ddevid");
        error("       http://$shost:$sport$spath -> http://$dhost:$dport$dpath");
        return 0;
    }

    # setup our pipe error handler, in case we get closed on
    my $pipe_closed = 0;
    local $SIG{PIPE} = sub { $pipe_closed = 1; };

    # okay, now get the file
    my $sock = IO::Socket::INET->new(PeerAddr => $shost, PeerPort => $sport, Timeout => 2)
        or return error("Unable to create socket to $shost:$sport for $spath");
    $sock->write("GET $spath HTTP/1.0\r\n\r\n");
    return error("Pipe closed retrieving $spath from $shost:$sport")
        if $pipe_closed;

    # we just want a content length
    my $clen;
    while (defined (my $line = <$sock>)) {
        $line =~ s/[\s\r\n]+$//;
        last unless length $line;
        if ($line =~ m!^HTTP/\d+\.\d+\s+(\d+)!) {
            # make sure we get a good response
            return $error->(1, "Error: Resource http://$shost:$sport$spath failed: HTTP $1")
                unless $1 >= 200 && $1 <= 299;
        }
        next unless $line =~ /^Content-length:\s*(\d+)\s*$/i;
        $clen = $1;
    }
    return $error->(1, "File $spath has a content-length of 0; unable to replicate")
        unless $clen;

    # open target for put
    my $dsock = IO::Socket::INET->new(PeerAddr => $dhost, PeerPort => $dport, Timeout => 2)
        or return error("Unable to create socket to $dhost:$dport for $dpath");
    $dsock->write("PUT $dpath HTTP/1.0\r\nContent-length: $clen\r\n\r\n")
        or return error("Unable to write data to $dpath on $dhost:$dport");
    return error("Pipe closed during write to $dpath on $dhost:$dport")
        if $pipe_closed;

    # now read data and print while we're reading.
    my ($data, $read, $written) = ('', 0, 0);
    while (!$pipe_closed && (my $bytes = $sock->read($data, $clen - $read))) {
        # now we've read in $bytes bytes
        $read += $bytes;
        my $wbytes = $dsock->send($data);
        $written += $wbytes;
        return error("Error: wrote $wbytes; expected to write $bytes; failed putting to $dpath")
            unless $wbytes == $bytes;
    }
    return error("Error: wrote $written bytes, expected to write $clen")
        unless $written == $clen;

    # now read in the response line (should be first line)
    my $line = <$dsock>;
    if ($line =~ m!^HTTP/\d+\.\d+\s+(\d+)!) {
        return 1 if $1 >= 200 && $1 <= 299;
        warn "Error: got a 404 in put: device not on host?: http://$dhost:$dport$dpath"
            if $1 == 404;
    } else {
        warn "Error: HTTP response line not recognized: $line";
    }
    return 0;
}

# replicates $fid if its devcount is less than $min.
sub replicate {
    my ($dbh, $fid, $min) = @_;

    my $lockname = "mgfs:fid:$fid:replicate";
    my $lock = $dbh->selectrow_array("SELECT GET_LOCK(?, 1)", undef,
                                     $lockname);
    return error("Unable to obtain lock $lockname")
        unless $lock;

    # hashref of devid -> $device_row_href  (where devid is alive)
    my $devs = Mgd::get_device_summary();
    return error("Device information from get_device_summary is empty")
        unless $devs && %$devs;

    # learn what devices this file is already on
    my $on_count = 0;
    my %on_host;     # hostid -> 1
    my @dead_devid;   # list of dead devids
    my @exist_devid;  # list of existing devids

    my $sth = $dbh->prepare("SELECT devid FROM file_on WHERE fid=?");
    $sth->execute($fid);
    die $dbh->errstr if $dbh->err;
    while (my ($devid) = $sth->fetchrow_array) {
        my $d = $devs->{$devid};
        unless ($d) {
            push @dead_devid, $devid;
            next;
        }
        $on_host{$d->{hostid}} = 1;
        $on_count++;
        push @exist_devid, $devid;
    }

    my $retunlock = sub {
        my $rv = shift;
        $dbh->selectrow_array("SELECT RELEASE_LOCK(?)", undef, $lockname);
        return $rv ? $rv : error($_[0]);
    };

    return $retunlock->(2) if $on_count >= $min;
    return $retunlock->(0, "Source is no longer available replicating $fid") if $on_count == 0;
    return $retunlock->(0, "No eligible devices available replicating $fid") if @exist_devid == 0;

    my $sdevid;

    while ($on_count < $min) {
        my $need = $min - $on_count;

        my @good_devids = Mgd::find_deviceid(
            random => 1,
            not_on_hosts => [ keys %on_host ],
            weight_by_free => 1,
        );

        # wasn't able to replicate enough?
        last unless @good_devids;

        my $ddevid = shift @good_devids;
        $sdevid ||= @exist_devid[int(rand(scalar @exist_devid))];

        my $rv = undef;
        if ($USE_HTTP) {
            $rv = http_copy($sdevid, $ddevid, $fid);
        } else {
            my $dst_path = $MOG_ROOT . "/" . make_path($ddevid, $fid);
            my $src_path = $MOG_ROOT . "/" . make_path($sdevid, $fid);
            $rv = File::Copy::copy($src_path, $dst_path);
        }

        return $retunlock->(0, "Copier failed replicating $fid") unless $rv;
        add_file_on($fid, $ddevid, 1);
        $on_count++;
    }

    return $retunlock->(1);
}

sub get_mindevcounts {
    # make sure we have good info
    Mgd::check_host_cache();
    my $host_ct = keys %Mgd::cache_host;
    
    # find the classes for each domainid (including domains without explict classes)
    my %min; # dmid -> classid -> mindevcount
    validate_dbh();
    my $dbh = get_dbh();
    my $sth = $dbh->prepare("SELECT d.dmid, c.classid, c.mindevcount ".
                            "FROM domain d LEFT JOIN class c ON d.dmid=c.dmid");
    $sth->execute;
    while (my ($dmid, $classid, $mct) = $sth->fetchrow_array) {
        $min{$dmid} ||= {};  # note the existence of this dmid

        # classid may be NULL (undef), in which case there are no classes defined
        # and we don't note the mindevcount (yet)
        $min{$dmid}{$classid} = int($host_ct < $mct ? $host_ct : $mct) if defined $classid;
    }


    # now iterate over %min again to set the implicit class
    foreach my $dmid (keys %min) {
        # each domain's classid=0, if not defined, has an implied mindevcount of $default_mindevcount
        # which most people will probably use.
        $min{$dmid}{0} = $host_ct < $default_mindevcount ? $host_ct : $default_mindevcount
            unless exists $min{$dmid}{0};
    }

    # return ref to hash
    return \%min;
}

sub job_monitor {
    my $parse_parent_response = sub {
        # now see what was in our message queue
        while (defined (my $line = <$psock>)) {
            $line =~ s/\r?\n$//;
            last if $line eq '.';

            # now find out what command this is?
            if ($line eq 'shutdown') {
                exit 0;
            }
        }
    };

    while (1) {
        sleep 15;

        # get db and note we're starting a run
        error("Monitor running; scanning usage files")
            if $Mgd::DEBUG >= 1;
        validate_dbh();
        my $dbh = get_dbh() or return 0;

        # general report in to parent
        send_to_parent('monitor_ping');
        $parse_parent_response->();

        # get a current list of devices
        my $devs = Mgd::get_device_summary();
        next unless $devs && %$devs;

        # now iterate over devices
        foreach my $dev (values %$devs) {
            my $host = $Mgd::cache_host{$dev->{hostid}};
            my $port = $host->{http_get_port} || $host->{http_port};
            my $url = "http://$host->{hostip}:$port/dev$dev->{devid}/usage";

            # now try to get the data with a short timeout
            my $ua = LWP::UserAgent->new( timeout => 2 );
            my $response = $ua->get($url);

            unless ($response->is_success) {
                error("Failed getting dev$dev->{devid}: " . $response->status_line);
                next;
            }

            my %stats;
            my $data = $response->content;
            foreach (split(/\r?\n/, $data)) {
                next unless /^(\w+)\s*:\s*(.+)$/;
                $stats{$1} = $2;
            }

            my ($used, $total) = ($stats{used}, $stats{total});
            unless ($used && $total) {
                error("dev$dev->{devid} reports used = $used, total = $total, error?");
                next;
            }

            # bytes => megabytes
            $used /= 1024;
            $total /= 1024;

            $dbh->do("UPDATE device SET mb_total = ?, mb_used = ?, mb_asof = UNIX_TIMESTAMP() " .
                     "WHERE devid = ?", undef, int($total), int($used), $dev->{devid});
            if ($dbh->err) {
                error("Database error in update query: " . $dbh->errstr);
                next;
            }

            error("dev$dev->{devid}: used = $used, total = $total")
                if $Mgd::DEBUG >= 1;
        }
    }
}

sub job_reaper {
    my $parse_parent_response = sub {
        # now see what was in our message queue
        while (defined (my $line = <$psock>)) {
            $line =~ s/\r?\n$//;
            last if $line eq '.';

            # now find out what command this is?
            if ($line eq 'shutdown') {
                exit 0;
            }
        }
    };

    while (1) {
        sleep 10;

        # get db and note we're starting a run
        error("Reaper running; looking for dead devices")
            if $Mgd::DEBUG >= 1;
        validate_dbh();
        my $dbh = get_dbh() or return 0;

        # general report in to parent
        send_to_parent('reaper_ping');
        $parse_parent_response->();

        # get a current list of devices
        my $devs = Mgd::get_device_summary(1);
        my @deaddevs = grep { $_->{status} eq 'dead' } values %$devs;
        next unless @deaddevs;

        # now iterate over dead devices
        foreach my $dev (@deaddevs) {
            my $devid = $dev->{devid};

            # look for files on this device
            my $fids = $dbh->selectcol_arrayref('SELECT fid FROM file_on WHERE devid = ? LIMIT 1000',
                                                undef, $devid);
            if ($dbh->err) {
                error("Error selecting jobs to reap: " . $dbh->errstr);
                next;
            }
            next unless $fids && @$fids;

            # note we got some
            error("Found " . scalar(@$fids) . " files on dead device $devid");

            # now iterate
            foreach my $fid (@$fids) {
                $dbh->do('DELETE FROM file_on WHERE fid = ? AND devid = ?',
                         undef, $fid, $devid);
                if ($dbh->err) {
                    error("Error deleting from file_on (file $fid, device $devid): " . $dbh->errstr);
                    next;
                }

                # now update the fid count
                unless (Mgd::update_fid_devcount($fid)) {
                    error("Error updating fid $fid devcount");
                    next;
                }

                # if debugging on, note this is done
                error("Reaper noted fid $fid no longer on device $devid")
                    if $Mgd::DEBUG >= 2;
            }
        }
    }
}

sub job_replicate {
    my $parse_parent_response = sub {
        # now see what was in our message queue
        while (defined (my $line = <$psock>)) {
            $line =~ s/\r?\n$//;
            last if $line eq '.';

            # now find out what command this is?
            if ($line =~ /^repl_was_done (\d+)/ && $_[0]) {
                delete $_[0]->{$1};
            } elsif ($line eq 'shutdown') {
                exit 0;
            }
        }
    };

    # { fid => lastcheck }; instructs us not to replicate this fid... we will clear
    # out fids from this list that are expired
    my %fidfailure;

    # { fid => 1 }; used to keep track of fids we find in the unreachable_fids table
    my %unreachable;

    my $sleep = 2;
    while (1) {
        sleep $sleep;
        validate_dbh();
        my $dbh = get_dbh() or return 0;

        # general report in to parent
        send_to_parent('repl_ping');
        $parse_parent_response->(undef);

        # start off assuming that we're going to get everything replicated and then take a break
        $sleep = 2;

        # update our unreachable fid list... we consider them good for 15 minutes
        my $urfids = $dbh->selectall_arrayref('SELECT fid, lastupdate FROM unreachable_fids');
        die $dbh->errstr if $dbh->err;
        foreach my $r (@{$urfids || []}) {
            my $nv = $r->[1] + 900;
            unless ($fidfailure{$r->[0]} && $fidfailure{$r->[0]} < $nv) {
                # given that we might have set it below to a time past the unreachable
                # 15 minute timeout, we want to only overwrite %fidfailure's idea of
                # the expiration time if we are extending it
                $fidfailure{$r->[0]} = $nv;
            }
            $unreachable{$r->[0]} = 1;
        }

        # get the min dev counts
        my %min = %{ Mgd::get_mindevcounts() };

        # iterate through each domain, replicating its contents
        foreach my $dmid (keys %min) {
            # iterate through each class, including the implicit class 0
            while (my ($classid, $min) = each %{$min{$dmid}}) {
                error("Checking replication for dmid=$dmid, classid=$classid, min=$min")
                    if $Mgd::DEBUG >= 1;

                my $LIMIT = 1000;

                # try going from devcount of 1 up to devcount of $min-1
                my %fidtodo; # fid => 1
                my $fixed = 0;
                my $attempted = 0;
                my $devcount = 1;
                while ($fixed < $LIMIT && $devcount < $min) {
                    my $now = time();
                    my $fids = $dbh->selectcol_arrayref("SELECT fid FROM file WHERE dmid=? AND classid=? ".
                                                        "AND devcount = ? AND length IS NOT NULL ".
                                                        "LIMIT $LIMIT", undef, $dmid, $classid, $devcount);
                    die $dbh->errstr if $dbh->err;
                    $fidtodo{$_} = 1 foreach @$fids;

                    # increase devcount so we try to replicate the files at the next devcount
                    $devcount++;

                    # see if we have any files to replicate
                    my $count = $fids ? scalar @$fids : 0;
                    error("  found $count for dmid=$dmid/classid=$classid/min=$min")
                        if $Mgd::DEBUG >= 1;
                    next unless $count;

                    # randomize the list so multiple daemons/threads working on
                    # replicate at the same time don't all fight over the
                    # same fids to move
                    my @randfids = randlist(@$fids);

                    error("Need to replicate: $dmid/$classid: @$fids") if $Mgd::DEBUG >= 2;
                    foreach my $fid (@randfids) {
                        # now replicate this fid
                        $attempted++;
                        next unless $fidtodo{$fid};

                        if ($fidfailure{$fid}) {
                            if ($fidfailure{$fid} < $now) {
                                delete $fidfailure{$fid};
                            } else {
                                next;
                            }
                        }

                        if (my $status = replicate($dbh, $fid, $min)) {
                            # $status is either 0 (failure, handled below), 1 (success, we actually
                            # replicated this file), or 2 (success, but someone else replicated it).
                            # so if it's 2, we just want to go to the next fid.  this file is done.
                            next if $status == 2;

                            # if it was no longer reachable, mark it reachable
                            if (delete $unreachable{$fid}) {
                                $dbh->do("DELETE FROM unreachable_fids WHERE fid = ?", undef, $fid);
                                die $dbh->errstr if $dbh->err;
                            }

                            # housekeeping
                            $fixed++;
                            send_to_parent("repl_i_did $fid");
                            $parse_parent_response->(\%fidtodo);

                            # status update
                            if ($fixed % 20 == 0) {
                                my $ratio = $fixed/$attempted*100;
                                error(sprintf("replicated=$fixed, attempted=$attempted, ratio=%.2f%%", $ratio))
                                    if $fixed % 20 == 0;
                            }
                        } else {
                            # failed in replicate, don't retry for a minute
                            $fidfailure{$fid} = $now + 60;
                        }
                    }
                }

                # if we did 1000, we just want to jump to the next pass through all domains and classes without pausing
                $sleep = 0 if $fixed >= $LIMIT;
            }
        }
    }
}

sub job_queryworker {
    # process lines of input, blocking.
    my $worker = QueryWorker->new($psock);
    while (defined (my $line = <$psock>)) {
        $line =~ s/[\r\n]+$//;
        validate_dbh();
        $worker->process_line(\$line);
    }
}


#####################################################################
### S E R V E R   A P I   F U N C T I O N S
#####################################################################

# returns hashref of devid -> $device_row_href  (where devid is alive/down, but not dead)
# cached for 15 seconds.
use vars qw($cache_device_summary $cache_device_summary_time %cache_host $cache_host_time);

# general purpose device locator.  example:
#
# my $devid = Mgd::find_deviceid(
#     random => 1,              # get random device (else find first suitable)
#     min_free_space => 100,    # with at least 100MB free
#     weight_by_free => 1,      # find result weighted by free space
#     max_disk_age => 5,        # minutes of age the last usage report can be before we ignore the disk
#     not_on_hosts => [ 1, 2 ], # no devices on hosts 1 and 2
# );
#
# returns undef if no suitable device was found.  else, if you wanted an
# array will return an array of the suitable devices--if you want just a
# single item, you get just the first one found.
sub find_deviceid {
    my %opts = ( @_ );

    # copy down global minimum free space if not specified
    $opts{min_free_space} ||= $min_free_space;
    $opts{max_disk_age} ||= $max_disk_age;
    $opts{max_disk_age} = time() - ($opts{max_disk_age} * 60);

    # setup for iterating over devices
    my $devs = Mgd::get_device_summary();
    my @devids = keys %{$devs || {}};
    my $devcount = scalar(@devids);
    my $start = $opts{random} ? int(rand($devcount)) : 0;
    my %not_on_host = ( map { $_ => 1 } @{$opts{not_on_hosts} || []} );
    my $total_free = 0;

    # now find a device that matches what they want
    my @list;
    for (my $i = 0; $i < $devcount; $i++) {
        my $idx = ($i + $start) % $devcount;
        my $dev = $devs->{$devids[$idx]};

        # series of suitability checks
        next unless $dev->{status} eq 'alive';
        next if $not_on_host{$dev->{hostid}};
        next if $opts{max_disk_age} && $dev->{mb_asof} &&
                $dev->{mb_asof} < $opts{max_disk_age};
        next if $opts{min_free_space} && $dev->{mb_total} &&
                $dev->{mb_free} < $opts{min_free_space};

        # we get here, this is a suitable device
        push @list, $dev->{devid};
        $total_free += $dev->{mb_free};
    }

    # now we have a list ordered randomly, do free space weighting
    if ($opts{weight_by_free}) {
        my $rand = int(rand($total_free));
        my $cur = 0;

        foreach my $devid (@list) {
            $cur += $devs->{$devid}->{mb_free};
            return $devid if $cur >= $rand;
        }
    }

    # return first listed suitable device
    return @list ? $list[0] : undef;
}

sub get_device_summary {
    my $include_dead = shift() ? ", 'dead'" : '';
    my $now = time;
    return $cache_device_summary if $cache_device_summary_time > $now - 15;

    my $dbh = get_dbh();

    # learn devices
    my %dev;  #
    my %hostdevs;  # hostid -> [ devid ]  (where devid is alive/down, but not dead)
    my $sth = $dbh->prepare("SELECT /*!40000 SQL_CACHE */ devid, hostid, mb_total, " .
                            "mb_used, mb_asof, status FROM device ".
                            "WHERE status IN ('alive', 'down' $include_dead)");
    $sth->execute;
    $dev{$_->{devid}} = $_ while $_ = $sth->fetchrow_hashref;

    # now override device status with host status if the host status is less than the device status
    Mgd::check_host_cache();
    foreach my $devid (keys %dev) {
        # makes others have an easier time of finding devices by free space
        $dev{$devid}->{mb_free} = $dev{$devid}->{mb_total} - $dev{$devid}->{mb_used};

        my $host_status = $cache_host{$dev{$devid}->{hostid}}->{status};
        if ($dev{$devid}->{status} eq 'alive' && $host_status ne 'alive') {
            $dev{$devid}->{status} = $host_status;
        } elsif ($dev{$devid}->{status} eq 'down' && $host_status eq 'dead') {
            $dev{$devid}->{status} = $host_status;
        }
    }

    $cache_device_summary_time = $now;
    return $cache_device_summary = \%dev;
}

sub check_host_cache {
    my $now = time;
    return if $cache_host_time > $now - 5;

    %cache_host = ();
    my $dbh = get_dbh();
    my $sth = $dbh->prepare("SELECT /*!40000 SQL_CACHE */ hostid, status, hostname, " .
                            "hostip, http_port, http_get_port, remoteroot, altip, altmask FROM host");
    $sth->execute;
    while (my $host = $sth->fetchrow_hashref) {
        $cache_host{$host->{hostid}} = $host;
        $cache_host{$host->{hostid}}->{mask} = Net::Netmask->new2($host->{altmask})
            if $host->{altip} && $host->{altmask};
    }
    $cache_host_time = $now;
}

sub key_filerow {
    my ($dbh, $dmid, $key) = @_;
    my $row = $dbh->selectrow_hashref("SELECT fid, dmid, dkey, length, classid, devcount ".
                                      "FROM file WHERE dmid=? AND dkey=?",
                                      undef, $dmid, $key);
    return $row;
}

# see if we should reduce the number of active children
sub job_needs_reduction {
    my $job = shift;
    return $jobs{$job}->[0] < $jobs{$job}->[1];
}

# given a file descriptor number and a timeout, wait for that descriptor to
# become readable; returns 0 or 1 on if it did or not
sub wait_for_readability {
    my ($fileno, $timeout) = @_;
    return 0 unless $fileno && $timeout;

    my $rin;
    vec($rin, $fileno, 1) = 1;
    my $nfound = select($rin, undef, undef, $timeout);

    # nfound can be undef or 0, both failures, or 1, a success
    return $nfound ? 1 : 0;
}

# get size of file, return 0 on error
sub get_file_size {
    my $path = shift;

    # quick case -- just a file on disk
    unless ($path =~ m!^http://([^:/]+)(?::(\d+))?(/.+)$!) {
        return -s "$Mgd::MOG_ROOT/$path"
    }
    my ($host, $port, $uri) = ($1, $2, $3);

    # don't sigpipe us
    local $SIG{'PIPE'} = "IGNORE" unless $FLAG_NOSIGNAL;

    # setup for sending size request to cached host
    my $req = "size $uri\r\n";
    my $reqlen = length $req;
    my $rv = 0;
    my $sock = $streamcache{$host};

    # sub to parse the response from $sock.  common code, so we have it here.
    my $parse_response = sub {
        # give the socket 3 seconds to become readable
        unless (Mgd::wait_for_readability(fileno($sock), $node_timeout)) {
            close($sock);
            return 0;
        }

        # now we know there's readable data
        my $line = <$sock>;
        return 0 unless defined $line;
        return 0 unless $line =~ /^(\S+)\s+(-?\d+)/; # expected format: "uri size"
        return error("get_file_size() requested size of $path, got back size of $1 ($2 bytes)")
            if $1 ne $uri;
        return $2+0;
    };

    # try using the cached socket
    if ($sock) {
        $rv = send($sock, $req, $FLAG_NOSIGNAL);
        if ($!) {
            undef $streamcache{$host};
        } elsif ($rv != $reqlen) {
            return error("send() didn't return expected length ($rv, not $reqlen) for $path");
        } else {
            # success
            return $parse_response->();
        }
    }

    # try creating a connection to the stream
    unless ($rv) {
        $sock = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $MOGSTORED_STREAM_PORT, Timeout => 5);
        $streamcache{$host} = $sock;
        if ($sock) {
            $rv = send($sock, $req, $FLAG_NOSIGNAL);
            if ($!) {
                return error("error talking to mogstored stream ($path): $!");
            } elsif ($rv != $reqlen) {
                return error("send() didn't return expected length ($rv, not $reqlen) for $path");
            } else {
                # success
                return $parse_response->();
            }
        }
    }

    # failure case: use a HEAD request to get the size of the file
    my $sock = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $port, Timeout => 3)
        or return error("get_file_size() unable to contact mogstored for size of $path");
    $sock->write("HEAD $uri HTTP/1.0\r\n\r\n");
    while (defined (my $line = <$sock>)) {
        if ($line =~ /^Content-length: (\d+)/i) {
            # success
            return $1+0;
        }
    }

    # no content length found?
    return error("get_file_size() found no content-length header in response for $path");
}

sub class_id {
    my ($dmid, $class) = @_;
    return undef unless $dmid > 0 && length $class;

    my $dbh = Mgd::get_dbh;
    my $classid = $dbh->selectrow_array
        ("SELECT classid FROM class WHERE dmid=? AND classname=?", undef, $dmid, $class)
            or return undef;
    return undef unless $classid;
    return $classid;
}

sub domain_id {
    # check the cache for this item
    my $now = time();
    if ($domaincachetime + 5 < $now) {
        %domaincache = ();

        # now get updated list
        my $dbh = Mgd::get_dbh;
        my $domains = $dbh->selectall_arrayref('SELECT dmid, namespace FROM domain');
        foreach my $row (@{$domains || []}) {
            # namespace -> dmid
            $domaincache{$row->[1]} = $row->[0];
        }

        $domaincachetime = $now;
    }

    # just use cached version
    return $domaincache{$_[0]};
}

sub class_name {
    my ($dmid, $classid) = @_;
    return undef unless $dmid > 0 && length $classid;
    # FIXME: cache this

    # lookup class
    my $dbh = Mgd::get_dbh;
    my $classname = $dbh->selectrow_array
        ("SELECT classname FROM class WHERE dmid=? AND classid=?", undef, $dmid, $classid)
            or return undef;
    return undef unless $classname;
    return $classname;
}

sub domain_name {
    my $dmid = shift;
    # FIXME: cache this

    # lookup domain
    my $dbh = Mgd::get_dbh;
    my $namespace = $dbh->selectrow_array
        ("SELECT namespace FROM domain WHERE dmid=?", undef, $dmid);
    return $namespace;

}

sub hostid_name {
    my $hostid = shift;
    check_host_cache();
    my $h = $cache_host{$hostid};
    return $h ? $h->{hostname} : undef;
}

sub hostid_ip {
    my $hostid = shift;
    check_host_cache();
    my $h = $cache_host{$hostid};
    return undef unless $h;

    # if we have a client ip and an object for alt matching...
    if ($h->{mask} && $h->{altip} &&
            ($force_alt_zone || ($client_ip && $h->{altip} && $h->{mask}->match($client_ip)))) {
        return $h->{altip};
    } else {
        return $h->{hostip};
    }
}

sub hostid_http_port {
    my $hostid = shift;
    check_host_cache();
    my $h = $cache_host{$hostid};
    return $h ? $h->{http_port} : undef;
}

sub hostid_http_get_port {
    my $hostid = shift;
    check_host_cache();
    my $h = $cache_host{$hostid};
    return $h ? $h->{http_get_port} : undef;
}

sub make_http_path {
    my ($devid, $fid) = @_;

    my $dsum = get_device_summary();
    my $dinfo = $dsum->{$devid};
    return undef unless $dinfo;
    my $hostname = hostid_name($dinfo->{hostid});

    my $nfid = sprintf '%010d', $fid;
    my ( $b, $mmm, $ttt, $hto ) = ( $nfid =~ m{(\d)(\d{3})(\d{3})(\d{3})} );

    return "/dev$devid/$b/$mmm/$ttt/$nfid.fid";
}

sub make_full_url {
    # set use_get_port to be true to specify to use the get port
    my ($devid, $fid, $use_get_port) = @_;

    # get some information we'll need
    my $devs = Mgd::get_device_summary();
    my $dev = $devs->{$devid} or return undef;
    my $path = Mgd::make_http_path($devid, $fid) or return undef;
    my $host = Mgd::hostid_ip($dev->{hostid}) or return undef;
    my $port = $use_get_port ? Mgd::hostid_http_get_port($dev->{hostid}) : undef;
    $port ||= Mgd::hostid_http_port($dev->{hostid}) or return undef;
    return "http://$host:$port$path";
}

# if given an HTTP URL, break it down into [ host, port, URI ], else
# returns undef
sub is_url {
    my $path = shift;
    if ($path =~ m!^http://(.+?)(?::(\d+))?(/.+)$!) {
        return [ $1, $2 || 80, $3 ];
    }
    return undef;
}

sub make_path {
    # jump out if we should be using HTTP stuff
    return Mgd::make_full_url(@_) if $USE_HTTP;

    my ($devid, $fid) = @_;

    my $dsum = get_device_summary();
    my $dinfo = $dsum->{$devid};
    return undef unless $dinfo;
    my $hostname = hostid_name($dinfo->{hostid});

    my $nfid = sprintf '%010d', $fid;
    my ( $b, $mmm, $ttt, $hto ) = ( $nfid =~ m{(\d)(\d{3})(\d{3})(\d{3})} );

    my $path = "$hostname/dev$devid/$b/$mmm/$ttt/$nfid.fid";
    make_dirs( "$MOG_ROOT/$path" ) or return undef;

    return $path;
}

sub make_get_path {
    # the get path only changes for HTTP mode
    return Mgd::make_path(@_) unless $USE_HTTP;
    return Mgd::make_full_url(@_, 1);
}

sub make_dirs
{
    my $filename = shift;
    my $dir = File::Basename::dirname($filename);
    eval { File::Path::mkpath($dir, 0, 0775); };
    return $@ ? 0 : 1;
}

sub add_file_on {
    my ($fid, $devid, $no_lock) = @_;

    my $dbh = get_dbh() or return 0;

    my $rv = $dbh->do("INSERT IGNORE INTO file_on SET fid=?, devid=?",
                      undef, $fid, $devid);
    if ($rv > 0) {
        return update_fid_devcount($fid, $no_lock);
    } else {
        # was already on that device
        return 1;
    }
}

sub update_fid_devcount {
    my ($fid, $no_lock) = @_;

    my $dbh = get_dbh() or return 0;

    my $lockname = "mgfs:fid:$fid";
    unless ($no_lock) {
        my $lock = $dbh->selectrow_array("SELECT GET_LOCK(?, 10)", undef,
                                         $lockname);
        return 0 unless $lock;
    }
    my $ct = $dbh->selectrow_array("SELECT COUNT(*) FROM file_on WHERE fid=?",
                                   undef, $fid);

    $dbh->do("UPDATE file SET devcount=? WHERE fid=?", undef,
             $ct, $fid);

    unless ($no_lock) {
        $dbh->selectrow_array("SELECT RELEASE_LOCK(?)", undef, $lockname);
    }

    return 1;
}

sub randlist
{
    my @rlist = @_;
    my $size = scalar(@rlist);

    my $i;
    for ($i=0; $i<$size; $i++)
    {
        unshift @rlist, splice(@rlist, $i+int(rand()*($size-$i)), 1);
    }
    return @rlist;
}


#####################################################################
### C L I E N T   C L A S S
### A client is a user connection for sending requests to us.  Requests
### can either be normal user requests to be sent to a QueryWorker
### or management requests that start with a !.
#####################################################################
package Client;

use Danga::Socket ();
use base qw{Danga::Socket};

use fields qw{read_buf};

sub new {
    my Client $self = shift;
    $self = fields::new($self) unless ref $self;
    $self->SUPER::new( @_ );
    return $self;
}

# Client
sub event_read {
    my Client $self = shift;

    my $bref = $self->read(1024);
    return $self->close() unless defined $bref;
    $self->{read_buf} .= $$bref;

    while ($self->{read_buf} =~ s/^(.*?)\r?\n//) {
        next unless length $1;
        Frontend->HandleClientRequest($self, $1);
    }
}

# Client
sub event_err { my $self = shift; $self->close; }
sub event_hup { my $self = shift; $self->close; }

# just note that we've died
sub close {
    # mark us as being dead
    my Client $self = shift;
    Frontend->NoteDeadClient($self);
    $self->SUPER::close(@_);
}


#####################################################################
### W O R K E R C O N N   C L A S S
### This class maintains a connection to one of our various classes
### of workers.
#####################################################################
package WorkerConn;

use Danga::Socket ();
use base qw{Danga::Socket};

use fields qw{read_buf job pid cmd_buf reqid};

sub new {
    my WorkerConn $self = shift;
    $self = fields::new($self) unless ref $self;
    $self->SUPER::new( @_ );

    # mark as not a worker by default
    $self->{pid} = 0;
    $self->{reqid} = 0;
    $self->{job} = undef;
    $self->{cmd_buf} = [];

    return $self;
}

sub event_read {
    my WorkerConn $self = shift;

    my $bref = $self->read(1024);
    return $self->close() unless defined $bref;
    $self->{read_buf} .= $$bref;

    while ($self->{read_buf} =~ s/^(.+?)\r?\n//) {
        my $line = $1;
        if ($self->job eq 'queryworker' && (substr($line, 0, 5) ne 'error')) {
            Frontend->HandleQueryWorkerResponse($self, $line);
        } else {
            Frontend->HandleChildRequest($self, $line);
        }
    }
}

sub job {
    my WorkerConn $self = shift;
    return $self->{job} unless @_;
    return $self->{job} = shift;
}

sub pid {
    my WorkerConn $self = shift;
    return $self->{pid} unless @_;
    return $self->{pid} = shift;
}

sub event_hup { my $self = shift; $self->close; }

sub close {
    # mark us as being dead
    my WorkerConn $self = shift;
    Frontend->NoteDeadWorkerConn($self);
    $self->SUPER::close(@_);
}

sub enqueue_line {
    my WorkerConn $self = $_[0];
    return if $self->job eq 'queryworker'; # they don't use this queueing
    my $msg = "$_[1]\r\n";
    push @{$self->{cmd_buf}}, $msg;
}

sub drain_queue {
    my WorkerConn $worker = $_[0];
    foreach my $cmd (@{$worker->{cmd_buf}}) {
        $worker->write($cmd);
    }
    $worker->write(".\r\n");
    $worker->{cmd_buf} = [];
}


#####################################################################
### F R O N T E N D  C L A S S
### This class handles keeping lists of workers and clients and
### assigning them to eachother when things happen.  This is a purely
### event driven class.
#####################################################################
package Frontend;

# Mappings: fd => [ clientref, jobstring, starttime ]
# queues are just lists of Client class objects
# ChildrenByJob: job => { pid => $client }
# ErrorsTo: fid => Client
# RecentQueries: [ string, string, string, ... ]
# Stats: element => number
our ($IsChild, @QueryWorkerQueue, @ClientQueue, @RecentQueries,
     %Mappings, %ChildrenByJob, %ErrorsTo, %Stats);
$IsChild = 0;

# when a child is spawned, they'll have copies of all the data from the
# parent, but they don't need it.  this method is called when you want
# to indicate that this Frontend is running on a child and should clean.
sub SetAsChild {
    @QueryWorkerQueue = ();
    @ClientQueue = ();
    %Mappings = ();
    $IsChild = 1;
    %ErrorsTo = ();

    # and now kill off our event loop so that we don't waste time
    Client->SetPostLoopCallback(sub { return 0; });
}

# called when a child has died.  a child is someone doing a job for us,
# but it might be a queryworker or any other type of job.  we just want
# to remove them from our list of children.  they're actually respawned
# by the make_new_child function elsewhere in Mgd.
sub NoteDeadChild {
    my $pid = $_[1];
    foreach my $job (keys %ChildrenByJob) {
        return if # bail out if we actually delete one
            delete $ChildrenByJob{$job}->{$pid};
    }
}

# called when a client dies.  clients are users, management or non.
# we just want to remove them from the error reporting interface, if
# they happen to be part of it.
sub NoteDeadClient {
    my Client $client = $_[1];
    delete $ErrorsTo{$client->{fd}};
}

# called when the error function in Mgd is called and we're in the parent,
# so it's pretty simple that basically we just spit it out to folks listening
# to errors
sub NoteError {
    my Client $client;
    return unless %ErrorsTo;

    my $msg = ":: ${$_[1]}\r\n";
    foreach $client (values %ErrorsTo) {
        $client->write(\$msg);
    }
}

# take a new connection that we know is from one of our children, but
# we're not sure what type of child, so just set it in read mode until
# they tell us what they are
sub RegisterWorkerConn {
    my WorkerConn $worker = $_[1];
    $worker->watch_read(1);
}

# take a new worker and note that it's a worker and ready to be used
# for commands.  this is called when workers connect to the frontend.
sub RegisterQueryWorker {
    # basically take the worker, mark it as a worker, enqueue it,
    # and then try to process the outstanding queues
    my WorkerConn $worker = $_[1];
    Frontend->EnqueueQueryWorker($worker);
}

# puts a worker back in the queue, deleting any outstanding jobs in
# the mapping list for this fd.
sub EnqueueQueryWorker {
    # first arg is class, second is worker
    my WorkerConn $worker = $_[1];
    delete $Mappings{$worker->{fd}};

    # see if we need to kill off some workers
    if (Mgd::job_needs_reduction('queryworker')) {
        Mgd::error("Reducing queryworker headcount by 1.");
        Frontend->AskWorkerToDie($worker);
        return;
    }

    # must be okay, so put it in the queue
    push @QueryWorkerQueue, $worker;
    Frontend->ProcessQueues;
}

# if we need to kill off a worker, this function takes in the WorkerConn
# object, tells it to die, marks us as having requested its death, and decrements
# the count of running jobs.
sub AskWorkerToDie {
    my WorkerConn $worker = $_[1];
    $worker->write("shutdown\r\n");
    Mgd::note_pending_death($worker->job, $worker->pid);
}

# kill bored query workers so we can get down to the level requested.  this
# continues killing until we run out of folks to kill.
sub CullQueryWorkers {
    while (@QueryWorkerQueue && Mgd::job_needs_reduction('queryworker')) {
        my WorkerConn $worker = shift @QueryWorkerQueue;
        Frontend->AskWorkerToDie($worker);
    }
}

# called when we get a response from a worker.  this reenqueues the
# worker so it can handle another response as well as passes the answer
# back on to the client.
sub HandleQueryWorkerResponse {
    return Mgd::error("Frontend (Child) got worker response: $_[2]") if $IsChild;

    # got a response from a worker
    my WorkerConn $worker = $_[1];
    return unless $worker && $Mappings{$worker->{fd}};

    # get the client we're working with (if any)
    my Client $client = $Mappings{$worker->{fd}}->[0];

    # if we have no client, then we just got a standard message from
    # the queryworker and need to pass it up the line
    return Frontend->HandleChildRequest($worker, $_[2]) if !$client;

    # at this point it was a command response, but if the client has gone
    # away, just reenqueue this query worker
    return Frontend->EnqueueQueryWorker($worker) if $client->{closed};

    # <numeric id> [client-side time to complete] <response>
    my ($time, $id, $res);
    if ($_[2] =~ /^(\d+-\d+)\s+(\d+\.\d+)\s+(.+)$/) {
        # save time and response for use later
        ($id, $time, $res) = ($1, $2, $3);
    } elsif ($_[2] =~ /^(\d+-\d+)\s(.+)$/) {
        # didn't match, must be in a different format?
        ($id, $time, $res) = ($1, 'undef', $2);
    }

    # now, if it doesn't match
    unless ($id eq "$worker->{pid}-$worker->{reqid}") {
        Mgd::error("Worker responded with id $id, expected $worker->{pid}-$worker->{reqid}, killing");
        $client->close('worker_mismatch');
        return Frontend->AskWorkerToDie($worker);
    }

    # now time this interval and add to @RecentQueries
    my $tinterval = Time::HiRes::tv_interval([$Mappings{$worker->{fd}}->[2]]);
    push @RecentQueries, sprintf("%s %.4f %s", $Mappings{$worker->{fd}}->[1], $tinterval, $time);
    shift @RecentQueries if scalar(@RecentQueries) > 50;

    # send text to client, put worker back in queue
    $client->write("$res\r\n");
    Frontend->EnqueueQueryWorker($worker);
}

# called from various spots to empty the queues of available pairs.
sub ProcessQueues {
    return if $IsChild;

    # try to match up a client with a worker
    while (@QueryWorkerQueue && @ClientQueue) {
        # get client that isn't closed
        my $clref;
        while (@ClientQueue) {
            $clref = shift @ClientQueue;
            if (!defined $clref || $clref->[0]->{closed}) {
                $clref = undef;
                next;
            }

            # if we get here the client is valid
            last;
        }
        next unless $clref;

        # get worker and make sure it's not closed already
        my WorkerConn $worker = shift @QueryWorkerQueue;
        if (!defined $worker || $worker->{closed}) {
            unshift @ClientQueue, $clref;
            next;
        }

        # put in mapping and send data to worker
        push @$clref, Time::HiRes::gettimeofday();
        $Mappings{$worker->{fd}} = $clref;

        # increment our counter so we know what request counter this is going out
        $worker->{reqid}++;

        $worker->write("$worker->{pid}-$worker->{reqid} $clref->[1]\r\n");
        $worker->watch_read(1);
    }
}

# send short descriptions of commands we support to the user
sub SendHelp {
    my Client $client = $_[1];

    # not supported yet
    #my $whaton = $_[2];

    # send general purpose help
    $client->write(<<HELP);
Welcome to mogilefsd's built-in help system.  Available commands:

    !recent     Recently executed queries and how long they took.
    !queue      Queries that are pending execution.
    !stats      General stats on what we're up to.
    !watch      Observe errors/messages from children.
    !jobs       Outstanding job counts, desired level, and pids.
    !shutdown   IMMEDIATELY kill all of mogilefsd.  IMMEDIATELY.

    !replication
                See the replication status.  Output format:
                <domain> <class> <devcount> <files>

    !to <job class> <message>
                Send <message> to all workers of <job class>.
                Mostly used for debugging.

    !want <count> <job class>
                Alter the level of workers of this class desired.
                Example: !want 20 queryworker, !want 3 replicate.
                See !jobs for what jobs are available.

More to come...
.
HELP
    
}

# called when a client sends us text.  we just create a job for
# it and then call ProcessQueues.
sub HandleClientRequest {
    return Mgd::error("Frontend (Child) got request from client: $_[2]") if $IsChild;

    # if it's just 'help', 'h', '?', or something, do that
    if ((substr($_[2], 0, 1) eq '?') || ($_[2] eq 'help') || ($_[2] eq '')) {
        Frontend->SendHelp($_[1]);
        return;
    }

    # quick check to see if we the parent should handle this
    if (substr($_[2], 0, 1) eq '!') {
        my Client $client = $_[1];
        my ($cmd, $args) = ($_[2] =~ m/^!(.+?)(?:\s+(.+))?$/);

        my @out;
        if ($cmd =~ /^stats$/) {
            # print out some stats on the queues
            my $uptime = time - $Mgd::starttime;
            my $ccount = scalar(@ClientQueue);
            my $wcount = scalar(@QueryWorkerQueue);
            my $ipcount = scalar(keys %Mappings);
            push @out, "uptime $uptime",
                       "pending_queries $ccount",
                       "processing_queries $ipcount",
                       "bored_queryworkers $wcount",
                       map { "$_ $Stats{$_}" } sort keys %Stats;

        } elsif ($cmd =~ /^repl/) {
            Mgd::validate_dbh();
            my $dbh = Mgd::get_dbh();
            my $mdcs = Mgd::get_mindevcounts();
            foreach my $dmid (sort keys %$mdcs) {
                my $dmname = Mgd::domain_name($dmid);
                foreach my $classid (sort keys %{$mdcs->{$dmid}}) {
                    my $min = $mdcs->{$dmid}->{$classid};
                    next unless $min > 1;

                    my $classname = Mgd::class_name($dmid, $classid) || '_default';
                    foreach my $ct (1..$min-1) {
                        my $count = $dbh->selectrow_array('SELECT COUNT(*) FROM file WHERE dmid = ? AND classid = ? AND devcount = ?',
                                                          undef, $dmid, $classid, $ct);
                        push @out, "$dmname $classname $ct $count";
                    }
                }
            }

        } elsif ($cmd =~ /^shutdown/) {
            print "User requested shutdown: $args\n";
            kill 15, $$; # kill us, that kills our kids

        } elsif ($cmd =~ /^jobs/) {
            # dump out a list of running jobs and pids
            foreach my $job (sort keys %ChildrenByJob) {
                my $ct = scalar(keys %{$ChildrenByJob{$job}});
                push @out, "$job count $ct";
                push @out, "$job desired $jobs{$job}->[0]";
                push @out, "$job pids " . join(' ', sort { $a <=> $b } keys %{$ChildrenByJob{$job}});
            }

        } elsif ($cmd =~ /^want/) {
            # !want <count> <jobclass>
            # set the new desired staffing level for a class
            if ($args =~ /^(\d+)\s+(\S+)/) {
                my ($count, $job) = ($1, $2);

                # validate count
                $count = 0 if $count < 0;
                # FIXME ...add an upper limit?

                # now make sure it's a real job
                if (defined $jobs{$job}) {
                    $jobs{$job}->[0] = $count;
                    $Mgd::allkidsup = 0;
                    push @out, "Now desiring $count children doing '$job'.";

                    # try to clean out the queryworkers (if that's what we're doing?)
                    Frontend->CullQueryWorkers
                        if $job eq 'queryworker';
                } else {
                    my $classes = join(", ", sort keys %jobs);
                    push @out, "ERROR: Invalid class '$job'.  Valid classes: $classes";
                }
            } else {
                push @out, "ERROR: usage: !want <count> <jobclass>";
            }

        } elsif ($cmd =~ /^to/) {
            # !to <jobclass> <message>
            # sends <message> to all children of <jobclass>
            if ($args =~ /^(\S+)\s+(.+)/) {
                my $ct = Frontend->SendToChildrenByJob($1, $2);
                push @out, "Message sent to $ct children.";

            } else {
                push @out, "ERROR: usage: !to <jobclass> <message>";
            }

        } elsif ($cmd =~ /^queue/ || $cmd =~ /^pend/) {
            foreach my $clq (@ClientQueue) {
                push @out, $clq->[1];
            }

        } elsif ($cmd =~ /^watch/) {
            if (delete $ErrorsTo{$client->{fd}}) {
                push @out, "Removed you from watcher list.";
            } else {
                $ErrorsTo{$client->{fd}} = $client;
                push @out, "Added you to watcher list.";
            }

        } elsif ($cmd =~ /^recent/) {
            # show the most recent N queries
            push @out, @RecentQueries;

        } else {
            Frontend->SendHelp($client, $args);
        }
        $client->write(join("\r\n", @out) . "\r\n") if @out;
        $client->write(".\r\n");
        return;
    }

    # just push the input onto the client queue
    $Stats{queries}++;
    push @ClientQueue, [ $_[1], "cmd " . ($_[1]->peer_ip_string || '0.0.0.0') . " $_[2]" ];
    Frontend->ProcessQueues;
}

# a child has contacted us with some command/status/something.
sub HandleChildRequest {
    return Mgd::error("Frontend (Child) got request from child: $_[2]") if $IsChild;

    # if they have no job set, then their first line is what job they are
    # and not a command.  they also specify their pid, just so we know what
    # connection goes with what pid, in case it's ever useful information.
    my WorkerConn $child = $_[1];
    unless (defined $child->job) {
        my ($pid, $job) = ($_[2] =~ /^(\d+)\s+(.+)/);
        $child->job($job);
        $child->pid($pid);

        # now do any special case startup
        if ($job eq 'queryworker') {
            Frontend->RegisterQueryWorker($child);
        }

        # add to normal list
        $ChildrenByJob{$job}->{$child->pid} = $child;
        return;
    }

    # see if we should downsize this child
    my $check_job = sub {
        if (Mgd::job_needs_reduction($child->job)) {
            Mgd::error("Reducing headcount of " . $child->job . " job by 1.");
            Frontend->AskWorkerToDie($child);
        } else {
            $child->drain_queue;
        }
    };

    # at this point we've got a command of some sort
    my $cmd = $_[2];
    if ($cmd =~ /^error (.+)$/i) {
        # pass it on to our error handler, prefaced with the child's job
        Mgd::error("[" . $child->job . "(" . $child->pid . ")] $1");

    } elsif ($cmd =~ /^queue/) {
        # send out what we have queued up for it
        $child->drain_queue;

    } elsif ($cmd =~ /^del_i_looped/) {
        $check_job->();

    } elsif ($cmd =~ /^monitor_ping/) {
        $check_job->();

    } elsif ($cmd =~ /^reaper_ping/) {
        $check_job->();

    } elsif ($cmd =~ /^repl_ping/) {
        $check_job->();

    } elsif ($cmd =~ /^repl_unreachable (\d+)/) {
        # announce to the other replicators that this fid can't be reached, but note
        # that we don't actually drain the queue to the requestor, as the replicator
        # isn't in a place where it can accept a queue drain right now.
        Frontend->SendToChildrenByJob('replicate', "repl_unreachable $1", $child);

    } elsif ($cmd =~ /^repl_i_did (\d+)/) {
        my $fid = $1;

        # announce to the other replicators that this fid was done and then drain the
        # queue to this person.
        Frontend->SendToChildrenByJob('replicate', "repl_was_done $fid", $child);
        $check_job->();

    } else {
        # unknown command
        Mgd::error("Unknown command [$_[2]] from child; job=" . $child->job);
    }
}

# given a job class, and a message, send it to all children of that job.  returns
# the number of children the message was sent to.
# arguments: ( jobclass, message, [ child ] )
# if child is specified, the message will be sent to members of the job class that
# aren't that child.  so you can exclude the one that originated the message.
sub SendToChildrenByJob {
    my $childref = $ChildrenByJob{$_[1]};
    return 0 unless defined $childref && %$childref;
    my $msg = $_[2];

    foreach my $child (values %$childref) {
        # ignore the child specified as the third arg if one is sent
        next if defined $_[3] && $_[3] == $child;

        # send the message to this child
        $child->enqueue_line($msg);
    }
    return scalar(keys %$childref);
}

# called when we notice that a worker has bit it.  we might have to restart a
# job that they had been working on.
sub NoteDeadWorkerConn {
    return if $IsChild;

    # get parms and error check
    my WorkerConn $worker = $_[1];
    return unless $worker;

    # if there's a mapping for this worker's fd, they had a job that didn't get done
    if ($Mappings{$worker->{fd}}) {
        # unshift, since this one already went through the queue once
        unshift @ClientQueue, $Mappings{$worker->{fd}};
        delete $Mappings{$worker->{fd}};

        # now try to get it processing again
        Frontend->ProcessQueues;
    }
}


#####################################################################
### W O R K E R   C L A S S
### Class that handles all of the actions that a worker can take.
#####################################################################
package QueryWorker;

use fields qw{sock querystarttime reqid};

sub new {
    my QueryWorker $self = shift;

    $self = fields::new($self) unless ref $self;
    $self->{sock} = shift;
    $self->{querystarttime} = undef;
    $self->{reqid} = undef;

    return $self;
}

sub process_line {
    my QueryWorker $self = shift;
    my $lineref = shift;

    # see what kind of command this is
    return $self->err_line('unknown_command')
        unless $$lineref =~ /^(\d+-\d+)?\s*(\S+)\s+(\S+)\s*(.*)/;
    $self->{reqid} = $1 || undef;
    my ($cmd, $line) = ($2, $4);

    # set global variables for zone determination
    $client_ip = $3;
    $force_alt_zone = 0;

    # some basic commands we support
    if ($cmd eq 'echo') {
        Mgd::send_to_parent($line);
        return;
    } elsif ($cmd eq 'shutdown') {
        exit 0;
    }

    # fallback to normal command handling
    if ($line =~ /^(\w+)\s*(.*)/) {
        my ($cmd, $args) = ($1, $2);
        $cmd = lc($cmd);

        no strict 'refs';
        $self->{querystarttime} = Time::HiRes::gettimeofday();
        my $cmd_handler = *{"cmd_$cmd"}{CODE};
        if ($cmd_handler) {
            my $args = decode_url_args(\$args);
            $force_alt_zone = 1 if $args->{zone} eq 'alt';
            $cmd_handler->($self, $args);
            return;
        }
    }

    return $self->err_line('unknown_command');
}

# returns 0 on error, or dmid of domain
sub check_domain {
    my QueryWorker $self = shift;
    my $args = shift;

    return $self->err_line("no_domain") unless length($args->{domain});

    # validate domain
    my $dmid = Mgd::domain_id($args->{domain}) or
        return $self->err_line("unreg_domain");

    return $dmid;
}

sub cmd_sleep {
    my QueryWorker $self = shift;
    my $args = shift;
    sleep($args->{duration} || 10);
    return $self->ok_line;
}

sub cmd_create_open {
    my QueryWorker $self = shift;
    my $args = shift;

    # validate parameters
    my $dmid = $self->check_domain($args) or return 0;
    my $key = $args->{key} || "";
    my $multi = $args->{multi_dest} ? 1 : 0;

    # get DB handle
    my $dbh = Mgd::get_dbh or
        return $self->err_line("nodb");

    # figure out what classid this file is for
    my $class = $args->{class};
    my $classid = 0;
    if (length($class)) {
        # TODO: cache this
        $classid = $dbh->selectrow_array("SELECT classid FROM class ".
                                         "WHERE dmid=? AND classname=?",
                                         undef, $dmid, $class)
            or return $self->err_line("unreg_class");
    }

    # find a device to put this file on that has 100Mb free.
    my (@dests, @hosts);
    my $devs = Mgd::get_device_summary();
    while (scalar(@dests) < ($multi ? 3 : 1)) {
        my $devid = Mgd::find_deviceid(
            random => 1,
            weight_by_free => 1,
            not_on_hosts => \@hosts,
        );

        last unless defined $devid;

        push @dests, $devid;
        push @hosts, $devs->{$devid}->{hostid};
    }
    return $self->err_line("no_devices") unless @dests;

    # setup the new mapping.  we store the devices that we picked for
    # this file in here, knowing that they might not be used.  create_close
    # is responsible for actually mapping in file_on.
    $dbh->do("INSERT INTO tempfile SET ".
             " fid=NULL, dmid=?, dkey=?, classid=?, createtime=UNIX_TIMESTAMP(), devids=?",
             undef, $dmid, $key, $classid, join(',', @dests));
    return undef if $dbh->err;
    my $fid = $dbh->{mysql_insertid};  # FIXME: mysql-ism
    return undef unless $fid > 0;

    # original single path support
    return $self->ok_line({
        fid => $fid,
        devid => $dests[0],
        path => Mgd::make_path($dests[0], $fid),
    }) unless $multi;

    # multiple path support
    my $ct = 0;
    my $res = {};
    foreach my $devid (@dests) {
        $ct++;
        $res->{"devid_$ct"} = $devid;
        $res->{"path_$ct"} = Mgd::make_path($devid, $fid);
    }
    $res->{fid} = $fid;
    $res->{dev_count} = $ct;
    return $self->ok_line($res);
}

sub cmd_create_close {
    my QueryWorker $self = shift;
    my $args = shift;

    # validate parameters
    my $dmid = $self->check_domain($args) or return 0;
    my $key = $args->{key};

    my $fid = $args->{fid} or return $self->err_line("no_fid");
    my $devid = $args->{devid} or return $self->err_line("no_devid");
    my $path = $args->{path} or return $self->err_line("no_path");

    # is the provided path what we'd expect for this fid/devid?
    return $self->err_line("bogus_args")
        unless $path eq Mgd::make_path($devid, $fid);

    # get DB handle
    my $dbh = Mgd::get_dbh or
        return $self->err_line("nodb");

    # find the temp file we're closing and making real
    my $trow = $dbh->selectrow_hashref("SELECT classid, dmid, dkey ".
                                       "FROM tempfile WHERE fid=?",
                                       undef, $fid);
    return $self->err_line("no_temp_file") unless $trow;

    # if a temp file is closed without a provided-key, that means to
    # delete it.
    unless (length($key)) {
        # add to to-delete list
        $dbh->do("REPLACE INTO file_to_delete SET fid=?", undef, $fid);
        $dbh->do("DELETE FROM tempfile WHERE fid=?", undef, $fid);
        return $self->ok_line;
    }

    # see if we have a fid for this key already
    my $old_file = Mgd::key_filerow($dbh, $dmid, $key);
    if ($old_file) {
        # add to to-delete list
        $dbh->do("REPLACE INTO file_to_delete SET fid=?", undef, $old_file->{fid});
        $dbh->do("DELETE FROM file WHERE fid=?", undef, $old_file->{fid});
    }

    # get size of file and verify that it matches what we were given, if anything
    my $size = Mgd::get_file_size($path);
    return $self->err_line("size_mismatch", "Expected: $args->{size}; actual: $size; path: $path")
        if $args->{size} && ($args->{size} != $size);

    # TODO: check for EIO?
    return $self->err_line("empty_file") unless $size;

    # insert file_on row
    $dbh->do("INSERT IGNORE INTO file_on SET fid = ?, devid = ?", undef, $fid, $devid);
    return $self->err_line("db_error") if $dbh->err;

    my $rv = $dbh->do("REPLACE INTO file ".
                      "SET ".
                      "  fid=?, dmid=?, dkey=?, length=?, ".
                      "  classid=?, devcount=0", undef,
                      $fid, $dmid, $key, $size, $trow->{classid});
    return $self->err_line("db_error") unless $rv;

    $dbh->do("DELETE FROM tempfile WHERE fid=?", undef, $fid);

    if (Mgd::update_fid_devcount($fid)) {
        return $self->ok_line();
    } else {
        # FIXME: handle this better
        return $self->err_line("db_error");
    }
}

sub cmd_delete {
    my QueryWorker $self = shift;
    my $args = shift;

    # validate parameters
    my $dmid = $self->check_domain($args) or return 0;
    my $key = $args->{key};
    return $self->err_line("no_key") unless length($key);

    # get DB handle
    my $dbh = Mgd::get_dbh or
        return $self->err_line("nodb");

    # is this fid still owned by this key?
    my $fid = $dbh->selectrow_array("SELECT fid FROM file WHERE dmid=? AND dkey=?",
                                    undef, $dmid, $key);
    return $self->err_line("unknown_key") unless $fid;

    $dbh->do("DELETE FROM file WHERE fid=?", undef, $fid);
    $dbh->do("REPLACE INTO file_to_delete SET fid=?", undef, $fid);

    return $self->ok_line();

}

sub cmd_list_keys {
    my QueryWorker $self = shift;
    my $args = shift;

    # validate parameters
    my $dmid = $self->check_domain($args) or return 0;
    my ($prefix, $after, $limit) = ($args->{prefix}, $args->{after}, $args->{limit});
    return $self->err_line("no_key") unless $prefix;

    # now validate that after matches prefix
    return $self->err_line('after_mismatch')
        if $after && $after !~ /^$prefix/;

    # verify there are no % or \ characters
    return $self->err_line('invalid_chars')
        if $prefix =~ /[%\\]/;

    # escape underscores
    $prefix =~ s/_/\\_/g;

    # now fix the input... prefix always ends with a % so that it works
    # in a LIKE call, and after is either blank or something
    $prefix .= '%';
    $after ||= '';
    $limit ||= 1000;
    $limit += 0;

    # get DB handle
    my $dbh = Mgd::get_dbh or
        return $self->err_line("nodb");

    # now select out our keys
    my $keys = $dbh->selectcol_arrayref
        ('SELECT dkey FROM file WHERE dmid = ? AND dkey LIKE ? AND dkey > ? ' .
         "ORDER BY dkey LIMIT $limit", undef, $dmid, $prefix, $after);

    # if we got nothing, say so
    return $self->err_line('none_match') unless $keys && @$keys;

    # construct the output and send
    my $ret = { key_count => 0, next_after => '' };
    foreach my $key (@$keys) {
        $ret->{key_count}++;
        $ret->{next_after} = $key
            if $key gt $ret->{next_after};
        $ret->{"key_$ret->{key_count}"} = $key;
    }
    return $self->ok_line($ret);
}

sub cmd_rename {
    my QueryWorker $self = shift;
    my $args = shift;

    # validate parameters
    my $dmid = $self->check_domain($args) or return 0;
    my ($fkey, $tkey) = ($args->{from_key}, $args->{to_key});
    return $self->err_line("no_key") unless $fkey && $tkey;

    # get DB handle
    my $dbh = Mgd::get_dbh or
        return $self->err_line("nodb");

    # rename the file
    my $ct = $dbh->do('UPDATE file SET dkey = ? WHERE dmid = ? AND dkey = ?',
                      undef, $tkey, $dmid, $fkey);
    return $self->err_line("key_exists") if $dbh->err;
    return $self->err_line("unknown_key") unless $ct > 0;

    return $self->ok_line();
}

sub cmd_get_hosts {
    my QueryWorker $self = shift;
    my $args = shift;

    my $dbh = Mgd::get_dbh()
        or return $self->err_line("nodb");

    Mgd::check_host_cache();

    my $ret = { hosts => 0 };
    while (my ($hostid, $row) = each %Mgd::cache_host) {
        next if defined $args->{hostid} && $hostid != $args->{hostid};

        $ret->{hosts}++;
        while (my ($key, $val) = each %$row) {
            $ret->{"host$ret->{hosts}_$key"} = $val;
        }
    }

    return $self->ok_line($ret);
}

sub cmd_get_devices {
    my QueryWorker $self = shift;
    my $args = shift;

    my $dbh = Mgd::get_dbh()
        or return $self->err_line("nodb");

    my $devs = Mgd::get_device_summary();

    my $ret = { devices => 0 };
    while (my ($devid, $row) = each %$devs) {
        next if defined $args->{devid} && $devid != $args->{devid};

        $ret->{devices}++;
        while (my ($key, $val) = each %$row) {
            $ret->{"dev$ret->{devices}_$key"} = $val;
        }
    }

    return $self->ok_line($ret);
}

sub cmd_create_domain {
    my QueryWorker $self = shift;
    my $args = shift;

    my $dbh = Mgd::get_dbh()
        or return $self->err_line("nodb");

    my $domain = $args->{domain};
    return $self->err_line('no_domain') unless length $domain;

    # FIXME: add some sort of authentication/limitation on this?

    my $dmid = Mgd::domain_id($domain);
    return $self->err_line('domain_exists') if $dmid;

    # get the max domain id
    my $maxid = $dbh->selectrow_array('SELECT MAX(dmid) FROM domain');
    $dbh->do('INSERT INTO domain (dmid, namespace) VALUES (?, ?)',
             undef, $maxid + 1, $domain);
    return $self->err_line('failure') if $dbh->err;

    # return the domain id we created
    return $self->ok_line({ domain => $domain });
}

sub cmd_create_class {
    my QueryWorker $self = shift;
    my $args = shift;

    my $dbh = Mgd::get_dbh()
        or return $self->err_line("nodb");

    my $domain = $args->{domain};
    return $self->err_line('no_domain') unless length $domain;

    my $class = $args->{class};
    return $self->err_line('no_class') unless length $class;

    my $mindevcount = $args->{mindevcount}+0;
    return $self->err_line('invalid_mindevcount') unless $mindevcount > 0;

    # FIXME: add some sort of authentication/limitation on this?

    my $dmid = Mgd::domain_id($domain);
    return $self->err_line('no_domain') unless $dmid;

    my $cid = Mgd::class_id($dmid, $class);
    return $self->err_line('class_exists') if $cid && !$args->{update};

    # update or insert at this point
    if ($args->{update}) {
        # now replace the old class
        $dbh->do("REPLACE INTO class (dmid, classid, classname, mindevcount) VALUES (?, ?, ?, ?)",
                 undef, $dmid, $cid, $class, $mindevcount);
    } else {
        # get the max class id in this domain
        my $maxid = $dbh->selectrow_array
            ('SELECT MAX(classid) FROM class WHERE dmid = ?', undef, $dmid);

        # now insert the new class
        $dbh->do("INSERT INTO class (dmid, classid, classname, mindevcount) VALUES (?, ?, ?, ?)",
                 undef, $dmid, $maxid + 1, $class, $mindevcount);
    }
    return $self->err_line('failure') if $dbh->err;

    # return success
    return $self->ok_line({ class => $class, mindevcount => $mindevcount, domain => $domain });
}

sub cmd_update_class {
    my QueryWorker $self = shift;
    my $args = shift;

    # simply passes through to create_class with update set
    $self->cmd_create_class({ %$args, update => 1 });
}

sub cmd_get_domains {
    my QueryWorker $self = shift;
    my $args = shift;

    my $dbh = Mgd::get_dbh()
        or return $self->err_line("nodb");

    my $domains = $dbh->selectall_arrayref('SELECT dmid, namespace FROM domain');

    my $ret = {};
    my $outercount = 0;
    foreach my $row (@$domains) {
        $ret->{"domain" . ++$outercount} = $row->[1];

        # setup the return row for this set of classes
        my $classes = $dbh->selectall_arrayref
            ('SELECT classname, mindevcount FROM class WHERE dmid = ?', undef, $row->[0]);
        my $innercount = 0;
        foreach my $irow (@$classes) {
            $ret->{"domain${outercount}class" . ++$innercount . "name"} = $irow->[0];
            $ret->{"domain${outercount}class" . $innercount . "mindevcount"} = $irow->[1];
        }

        # record the default class and mindevcount
        $ret->{"domain${outercount}class" . ++$innercount . "name"} = 'default';
        $ret->{"domain${outercount}class" . $innercount . "mindevcount"} = $default_mindevcount;

        $ret->{"domain${outercount}classes"} = $innercount;
    }
    $ret->{"domains"} = $outercount;

    return $self->ok_line($ret);
}

sub cmd_get_paths {
    my QueryWorker $self = shift;
    my $args = shift;

    my $key = $args->{key};

    return $self->err_line("no_key") unless length($key);

    # validate domain
    my $dmid = $self->check_domain($args) or return 0;

    # get DB handle
    my $dbh = Mgd::get_dbh or
        return $self->err_line("nodb");

    my $filerow = Mgd::key_filerow($dbh, $dmid, $key);
    return $self->err_line("unknown_key") unless $filerow;

    my $fid = $filerow->{fid};
    my $dsum = Mgd::get_device_summary();

    my $ret = {
        paths => 0,
    };

    # is this fid still owned by this key?
    my $devids = $dbh->selectcol_arrayref("SELECT devid FROM file_on WHERE fid=?",
                                          undef, $fid) || [];
    my $devcount = scalar(@$devids);
    my $idx = int(rand() * $devcount);

    for (1..$devcount) {
        my $devid = $devids->[($_+$idx) % $devcount];
        my $dev = $dsum->{$devid};
        next unless $dev && $dev->{status} eq "alive";
        my $path = Mgd::make_get_path($devid, $fid);
        next unless $ret->{paths} || $args->{noverify} ||
                        (Mgd::get_file_size($path) == $filerow->{length});
        my $n = ++$ret->{paths};
        $ret->{"path$n"} = $path;
        last if $n == 2;   # one verified, one likely seems enough for now.  time will tell.
    }

    return $self->ok_line($ret);
}

sub cmd_set_state {
    my QueryWorker $self = shift;
    my $args = shift;

    # get database handle
    my $ret = {};
    my $dbh = Mgd::get_dbh
        or return $self->err_line('nodb');

    # figure out what they want to do
    my ($host, $dev, $state) = ($args->{host}, $args->{device}+0, $args->{state});
    return $self->err_line('bad_params')
        unless $host && $dev && ($state =~ /^(?:alive|down|dead)$/);

    # now get this device's current state and host
    my ($realhost, $curstate) =
        $dbh->selectrow_array('SELECT hostname, device.status FROM host, device ' .
                              'WHERE host.hostid = device.hostid AND device.devid = ?',
                              undef, $dev);

    # verify host is the same
    return $self->err_line('host_mismatch')
        unless $realhost eq $host;

    # make sure the destination state isn't too high
    return $self->err_line('state_too_high')
        if $curstate eq 'dead' && $state eq 'alive';

    # update the state in the database now
    $dbh->do('UPDATE device SET status = ? WHERE devid = ?', undef, $state, $dev);
    return $self->err_line('failure') if $dbh->err;

    # success, state changed
    return $self->ok_line($ret);
}

sub cmd_stats {
    my QueryWorker $self = shift;
    my $args = shift;

    # get database handle
    my $ret = {};
    my $dbh = Mgd::get_dbh
        or return $self->err_line('nodb');

    # get names of all domains and classes for use later
    my %classes;
    my $rows = $dbh->selectall_arrayref('SELECT class.dmid, namespace, classid, classname ' .
                                        'FROM domain, class WHERE class.dmid = domain.dmid');
    foreach my $row (@$rows) {
        $classes{$row->[0]}->{name} = $row->[1];
        $classes{$row->[0]}->{classes}->{$row->[2]} = $row->[3];
    }
    $classes{$_}->{classes}->{0} = 'default'
        foreach keys %classes;

    # get host and device information with device status
    my %devices;
    my $rows = $dbh->selectall_arrayref('SELECT device.devid, hostname, device.status ' .
                                        'FROM device, host WHERE device.hostid = host.hostid');
    foreach my $row (@$rows) {
        $devices{$row->[0]}->{host} = $row->[1];
        $devices{$row->[0]}->{status} = $row->[2];
    }

    # if they want replication counts, or didn't specify what they wanted
    if ($args->{replication} || $args->{all}) {
        # replication stats
        my $stats = $dbh->selectall_arrayref('SELECT dmid, classid, devcount, COUNT(devcount) FROM file GROUP BY 1, 2, 3');
        my $count = 0;
        foreach my $stat (@$stats) {
            $count++;
            $ret->{"replication${count}domain"} = $classes{$stat->[0]}->{name};
            $ret->{"replication${count}class"} = $classes{$stat->[0]}->{classes}->{$stat->[1]};
            $ret->{"replication${count}devcount"} = $stat->[2];
            $ret->{"replication${count}files"} = $stat->[3];
        }
        $ret->{"replicationcount"} = $count;
    }

    # file statistics (how many files there are and in what domains/classes)
    if ($args->{files} || $args->{all}) {
        my $stats = $dbh->selectall_arrayref('SELECT dmid, classid, COUNT(classid) FROM file GROUP BY 1, 2');
        my $count = 0;
        foreach my $stat (@$stats) {
            $count++;
            $ret->{"files${count}domain"} = $classes{$stat->[0]}->{name};
            $ret->{"files${count}class"} = $classes{$stat->[0]}->{classes}->{$stat->[1]};
            $ret->{"files${count}files"} = $stat->[2];
        }
        $ret->{"filescount"} = $count;
    }

    # device statistics (how many files are on each device)
    if ($args->{devices} || $args->{all}) {
        my $stats = $dbh->selectall_arrayref('SELECT devid, COUNT(devid) FROM file_on GROUP BY 1');
        my $count = 0;
        foreach my $stat (@$stats) {
            $count++;
            $ret->{"devices${count}id"} = $stat->[0];
            $ret->{"devices${count}host"} = $devices{$stat->[0]}->{host};
            $ret->{"devices${count}status"} = $devices{$stat->[0]}->{status};
            $ret->{"devices${count}files"} = $stat->[1];
        }
        $ret->{"devicescount"} = $count;
    }

    # FIXME: DO! add other stats

    return $self->ok_line($ret);
}

sub ok_line {
    my QueryWorker $self = shift;

    my $delay = '';
    if ($self->{querystarttime}) {
        $delay = sprintf("%.4f ", Time::HiRes::tv_interval([ $self->{querystarttime} ]));
        $self->{querystarttime} = undef;
    }

    my $id = defined $self->{reqid} ? "$self->{reqid} " : '';

    my $args = shift;
    my $argline = join('&', map { eurl($_) . "=" . eurl($args->{$_}) } keys %$args);
    $self->{sock}->write("${id}${delay}OK $argline\r\n");
    return 1;
}

# first argument: error code.
# second argument: optional error text.  text will be taken from code if no text provided.
sub err_line {
    my QueryWorker $self = shift;
    my $err_code = shift;
    my $err_text = shift || {
        'unknown_command' => "Unknown server command",
        'no_domain' => "No domain provided",
        'no_class' => "No class provided",
        'unreg_domain' => "Domain name invalid/not found",
        'class_exists' => "That class already exists in that domain",
        'domain_exists' => "That domain already exists",
        'invalid_mindevcount' => "The mindevcount must be at least 1",
        'bad_params' => "Invalid parameters to command; please see documentation",
        'host_mismatch' => "The device specified doesn't belong to the host specified",
        'state_too_high' => "Status cannot go from dead to alive; must use down",
        'failure' => "Operation failed",
        'key_exists' => "Target key name already exists; can't overwrite.",
        'none_match' => "No keys match that pattern and after-value (if any).",
        'after_mismatch' => "Pattern does not match the after-value?",
        'invalid_chars' => "Patterns must not contain backslashes (\\) or percent signs (%).",
    }->{$err_code};

    my $delay = '';
    if ($self->{querystarttime}) {
        $delay = sprintf("%.4f ", Time::HiRes::tv_interval([ $self->{querystarttime} ]));
        $self->{querystarttime} = undef;
    }

    my $id = defined $self->{reqid} ? "$self->{reqid} " : '';

    $self->{sock}->write("${id}${delay}ERR $err_code " . eurl($err_text) . "\r\n");
    return 0;
}

sub eurl
{
    my $a = $_[0];
    $a =~ s/([^a-zA-Z0-9_\,\-.\/\\\: ])/uc sprintf("%%%02x",ord($1))/eg;
    $a =~ tr/ /+/;
    return $a;
}

sub decode_url_args
{
    my $a = shift;
    my $buffer = ref $a ? $a : \$a;
    my $ret = {};

    my $pair;
    my @pairs = split(/&/, $$buffer);
    my ($name, $value);
    foreach $pair (@pairs)
    {
        ($name, $value) = split(/=/, $pair);
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $name =~ tr/+/ /;
        $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        $ret->{$name} .= $ret->{$name} ? "\0$value" : $value;
    }
    return $ret;
}


# Local Variables:
# mode: perl
# c-basic-indent: 4
# indent-tabs-mode: nil
# End: