view release on metacpan or  search on metacpan

lib/Mojolicious/Plugin/ServerStatus.pm  view on Meta::CPAN

my $prev={};
sub set_state {
    my $self = shift;
    return if !$self->{__scoreboard};

    my $status = shift || '_';
    my $env = shift;
    if ( $env ) {
        no warnings 'uninitialized';
        $prev = {
            remote_addr => $env->{REMOTE_ADDR},
            host => defined $env->{HTTP_HOST} ? $env->{HTTP_HOST} : '-',
            method => $env->{REQUEST_METHOD},
            uri => $env->{REQUEST_URI},
            protocol => $env->{SERVER_PROTOCOL},
            user => $env->{USER},
            time => time(),
        };
    }
    $self->{__scoreboard}->update($JSON->encode({
        %{$prev},
        pid => $$,
        ppid => getppid(),
        uptime => $self->{uptime},
        status => $status,
    }));
}

sub _handle_server_status {
    my ($self) = @_;


    my $upsince = time - $self->{uptime};
    my $duration = "";
    my @spans = (86400 => 'days', 3600 => 'hours', 60 => 'minutes');
    while (@spans) {
        my ($seconds,$unit) = (shift @spans, shift @spans);
        if ($upsince > $seconds) {
            $duration .= int($upsince/$seconds) . " $unit, ";
            $upsince = $upsince % $seconds;
        }
    }
    $duration .= "$upsince seconds";

    my $body="Uptime: $self->{uptime} ($duration)\n";
    my %status = ( 'Uptime' => $self->{uptime} );

    if ( $self->conf->{counter_file} ) {
        my ($counter,$bytes) = $self->counter;
        my $kbytes = int($bytes / 1_000);
        $body .= sprintf "Total Accesses: %s\n", $counter;
        $body .= sprintf "Total Kbytes: %s\n", $kbytes;
        $status{TotalAccesses} = $counter;
        $status{TotalKbytes} = $kbytes;
    }

    if ( my $scoreboard = $self->{__scoreboard} ) {
        my $stats = $scoreboard->read_all();
        my $idle = 0;
        my $busy = 0;

        my @all_workers = ();
        my $parent_pid = getppid;
        
        if ( $self->skip_ps_command ) {
            # none
            @all_workers = keys %$stats;
        }
        elsif ( $^O eq 'cygwin' ) {
            my $ps = `ps -ef`;
            $ps =~ s/^\s+//mg;
            for my $line ( split /\n/, $ps ) {
                next if $line =~ m/^\D/;
                my @proc = split /\s+/, $line;
                push @all_workers, $proc[1] if $proc[2] == $parent_pid;
            }
        }
        elsif ( $^O !~ m!mswin32!i ) {
            my $psopt = $^O =~ m/bsd$/ ? '-ax' : '-e';
            my $ps = `LC_ALL=C command ps $psopt -o ppid,pid`;
            $ps =~ s/^\s+//mg;
            for my $line ( split /\n/, $ps ) {
                next if $line =~ m/^\D/;
                my ($ppid, $pid) = split /\s+/, $line, 2;
                push @all_workers, $pid if $ppid == $parent_pid;
            }
        }
        else {
            # todo windows?
            @all_workers = keys %$stats;
        }

        my $process_status = '';
        my @process_status;
        for my $pid ( @all_workers  ) {
            my $json = $stats->{$pid};
            my $pstatus = eval { 
                $JSON->decode($json || '{}');
            };
            $pstatus ||= {};
            if ( $pstatus->{status} && $pstatus->{status} eq 'A' ) {
                $busy++;
            }
            else {
                $idle++;
            }

            if ( defined $pstatus->{time} ) {
                $pstatus->{ss} = time - $pstatus->{time};
            }
            $pstatus->{pid} ||= $pid;
            delete $pstatus->{time};
            delete $pstatus->{ppid};
            delete $pstatus->{uptime};
            $process_status .= sprintf "%s\n", 
                join(" ", map { defined $pstatus->{$_} ? $pstatus->{$_} : '' } qw/pid status remote_addr host user method uri protocol ss/);
            push @process_status, $pstatus;
        }
        $body .= <<EOF;
BusyWorkers: $busy
IdleWorkers: $idle
--
pid status remote_addr host user method uri protocol ss
$process_status
EOF
        chomp $body;
        $status{BusyWorkers} = $busy;
        $status{IdleWorkers} = $idle;
        $status{stats} = \@process_status;
    }
    else {
       $body .= "WARN: Scoreboard has been disabled\n";
       $status{WARN} = 'Scoreboard has been disabled';
    }
    return ($body, \%status);

}

sub allowed {
    my ( $self , $address ) = @_;
    if ( $address =~ /:/) {
        return unless $self->{__cidr6};
        return $self->{__cidr6}->find( $address );
    }
    return unless $self->{__cidr4};
    return $self->{__cidr4}->find( $address );
}

sub counter {
    my $self = shift;
    my $parent_pid = getppid;
    if ( ! $self->{__counter} ) {
        open( my $fh, '+<:unix', $self->conf->{counter_file} ) or die "cannot open counter_file: $!";
        $self->{__counter} = $fh;
        flock $fh, LOCK_EX;
        my $len = sysread $fh, my $buf, 10;
        if ( !$len || $buf != $parent_pid ) {
            seek $fh, 0, 0;
            syswrite $fh, sprintf("%-10d%-20d%-20d", $parent_pid, 0, 0);
        } 
        flock $fh, LOCK_UN;
    }
    if ( @_ ) {
        my ($count, $bytes) = @_;
        $count ||= 1;
        $bytes ||= 0;
        my $fh = $self->{__counter};
        flock $fh, LOCK_EX;
        seek $fh, 10, 0;
        sysread $fh, my $buf, 40;
        my $counter = substr($buf, 0, 20);
        my $total_bytes = substr($buf, 20, 20);
        $counter ||= 0;
        $total_bytes ||= 0;
        $counter += $count;
        if ($total_bytes + $bytes > 2**53){ # see docs
            $total_bytes = 0;
        } else {
            $total_bytes += $bytes;
        }
        seek $fh, 0, 0;
        syswrite $fh, sprintf("%-10d%-20d%-20d", $parent_pid, $counter, $total_bytes);
        flock $fh, LOCK_UN;
        return $counter;
    }
    else {
        my $fh = $self->{__counter};