#!/usr/local/sysmansw/runtime/perl/bin/perl -w

#
## -_- $Name: Uptimetrics-1_4b $ % $Id: umfe,v 1.31 2001/09/08 16:47:10 sietse Exp $
#
# ***
# *** Copyright(c) 2000
# ***    Sysman Software B.V. 
# ***
#

use CGI;
use IO::Handle;
use Time::Local;
use GD;
use strict;

my $UMDIR = $ENV{'UMDIR'};
$UMDIR = $ENV{'HOME'} . "/uptimetrics" if not defined($UMDIR);

my $timezone;
my %sessions;

my $services_file = "$UMDIR/data/services/services";
my $checks_file = "$UMDIR/data/checks/checks";
my $pwd_file = "$UMDIR/data/.users";
my @wd = qw/Sun Mon Tue Wed Thu Fri Sat/;
my %wd = (0 => 'Sun', 1 => 'Mon', 2 => 'Tue', 3 => 'Wed', 4 => 'Thu', 5 => 'Fri', 6 => 'Sat');
my $is_admin = 0;

my $h_color = '#ff6666';
my $l_color = '#99ffcc';
my $r_color = '#ccccff';
my $r_color_low = '#9999cc';

my $style_top = "
      body { font-family: verdana, arial; font-size: 10pt; background: $h_color; }
      td { font-family: verdana, arial; font-size: 10pt; background: $h_color; }
      a { color: #0000ff; text-decoration: none; }
      a.link { color: #0000ff; text-decoration: none; }
      a.visited { color: #0000ff; text-decoration: none; }
      a.active d{ color: #0000ff; text-decoration: none; }
      h1 { font-size: 18pt; font-weight: bold; }
      h2 { font-size: 16pt; font-weight: bold; }
      h3 { font-size: 14pt; font-weight: bold; }
      h4 { font-size: 12pt; font-weight: bold; }
";
my $style_left = "
      body { font-family: verdana, arial; font-size: 10pt; background: $l_color; }
      td { font-family: verdana, arial; font-size: 10pt; background: $l_color; }
      a { color: #0000ff; text-decoration: none; }
      a.link { color: #0000ff; text-decoration: none; }
      a.visited { color: #0000ff; text-decoration: none; }
      a.active d{ color: #0000ff; text-decoration: none; }
      h1 { font-size: 18pt; font-weight: bold; }
      h2 { font-size: 16pt; font-weight: bold; }
      h3 { font-size: 14pt; font-weight: bold; }
      h4 { font-size: 12pt; font-weight: bold; }
";
my $style_right = "
      body { font-family: verdana, arial; font-size: 10pt; background: $r_color; }
      td { font-family: verdana, arial; font-size: 10pt; background: $r_color; }
      td.low { font-family: verdana, arial; font-size: 10pt; background: $r_color_low; }
      td.white { font-family: verdana, arial; font-size: 10pt; background: white; }
      a { color: #0000ff; text-decoration: none; }
      a.link { color: #0000ff; text-decoration: none; }
      a.visited { color: #0000ff; text-decoration: none; }
      a.active d{ color: #0000ff; text-decoration: none; }
      h1 { font-size: 18pt; font-weight: bold; }
      h2 { font-size: 16pt; font-weight: bold; }
      h3 { font-size: 14pt; font-weight: bold; }
      h4 { font-size: 12pt; font-weight: bold; }
";

##########################################################################
##########################################################################
##########################################################################

sub logmsg
{
    my $msg = shift @_;
    my $tm;

    chomp($tm = localtime(time));
    print STDERR "$tm: ". $msg;
}

sub logdie
{
    my $msg = shift @_;
    my $tm;

    chomp($tm = localtime(time));
    die "$tm: ". $msg;
}

##########################################################################
##########################################################################
##########################################################################

sub getconfig
{
}

sub to_unxdate
{
    my $datestr = shift;

    $datestr =~ /(\d{4})(\d{2})(\d{2})/;
    return timelocal(0, 0, 0, $3, $2 - 1, $1 - 1900);
}

sub sendimg
{
    my $q = shift;
    my ($nread, $buffer);

    my $img = $q->param('img');

    open(IMG, "<$UMDIR/web/$img") or logmsg "Cannot open img: $!\n";
    print "Content-type: image/gif\n\n";

    $nread = read IMG, $buffer, 4096;
    syswrite STDOUT, $buffer, $nread;

    close IMG;
}

sub mk_expiry($)
{
    my $tm = shift @_;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$idst);
    my $str;

    ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$idst) = localtime($tm);
    $str = "Sunday " if $wday == 0;
    $str = "Monday " if $wday == 1;
    $str = "Tuesday " if $wday == 2;
    $str = "Wednesday " if $wday == 3;
    $str = "Thursday " if $wday == 4;
    $str = "Friday " if $wday == 5;
    $str = "Saterday " if $wday == 6;

    $str .= sprintf("%02d-" , $mday);

    $str .= "Jan-" if $mon == 0;
    $str .= "Feb-" if $mon == 1;
    $str .= "Mar-" if $mon == 2;
    $str .= "Apr-" if $mon == 3;
    $str .= "May-" if $mon == 4;
    $str .= "Jun-" if $mon == 5;
    $str .= "Jul-" if $mon == 6;
    $str .= "Aug-" if $mon == 7;
    $str .= "Sep-" if $mon == 8;
    $str .= "Oct-" if $mon == 9;
    $str .= "Nov-" if $mon == 10;
    $str .= "Dec-" if $mon == 11;

    chomp($timezone = `date +%Z`);
    $str .= sprintf ("%02d %02d:%02d:%02d %s", $year, $hour, $min, $sec, $timezone);

    return $str;
}

##################################################################
##################################################################
##################################################################

sub verify_access
{
    my ($q, $srv) = @_;

    my $cookie = $q->cookie(-name => 'Uptimetrics');
    $cookie = "<unknown>" if not $cookie;
    my $user = $sessions{$cookie};
    if (! $user)
    {
        &not_logged_in($q);
        return;
    }

    open PWD, "$pwd_file" or logdie "Cannot open $pwd_file: $!\n";
    my @pwd = <PWD>;
    close PWD;
 
    chomp @pwd;
    foreach my $pwd (@pwd)
    {
        my @items = split /:/, $pwd;
        my $uid = $items[0];
        my $adm = $items[2];
        my @allowed = split /,/, $items[3];

        if ($user eq $uid)
        {
            $is_admin = ($adm eq "admin") ? 1 : 0;
            return 1 if $allowed[0] eq "ALL";
            return 1 if grep /^$srv$/, @allowed;
            last;
        }
    }

    print $q->header,
          $q->start_html(-title   => 'Access denied',
                         -vlink   => '#0000ff',
                         -style   => $style_right,
                         -target  => "_top"),
          $q->h1("Uptimetrics"),
          $q->b("Access denied."),
          $q->p,
          $q->a({href => $q->url() . "?status=1"} , "Login"),
          $q->end_html;

    return 0;
}

##################################################################
##################################################################
##################################################################

my $font          = gdLargeFont;
my $width         = 500;
my $height        = 175;
my $left_margin   = $font->width * 7;
my $right_margin  = 25;
my $top_margin    = 30;
my $bottom_margin = 30;
my $origin_x      = $left_margin;
my $origin_y      = $height - $bottom_margin;

my ($black, $gray, $red, $green, $blue, $white);

sub init_image
{
    my ($title, $r_min) = @_;

    my $image = new GD::Image($width, $height);

    $black = $image->colorAllocate(  0,   0,   0);
    $gray  = $image->colorAllocate(240, 240, 240);
    $red   = $image->colorAllocate(255,   0,   0);
    $green = $image->colorAllocate(  0, 224,   0);
    $blue  = $image->colorAllocate(  0,   0, 255);
    $white = $image->colorAllocate(255, 255, 255);

    $image->filledRectangle(0, 0, $width, $height, $gray);

    my $title_x = ($width - (length($title) * $font->width)) / 2;
    $image->string($font, $title_x, 5, $title, $black);

    # Draw the x-axis
    $image->line($origin_x, $height - $bottom_margin,
                 $width - $right_margin, $height - $bottom_margin, $black);

    # Draw the y-axis
    $image->line($origin_x, $top_margin, $origin_x,
                 $height - $bottom_margin, $black);

    my $middle = ($height - $top_margin - $bottom_margin)/2 + $top_margin;
    $image->setStyle($black, gdTransparent, gdTransparent);
    $image->line($origin_x, $top_margin, $width - $right_margin, $top_margin, gdStyled);
    $image->line($origin_x, $middle, $width - $right_margin, $middle, gdStyled);

    $image->string($font,
                   $origin_x - 5 - length("100%") * $font->width,
                   $top_margin - $font->height / 2,
                   "100%", $black);
    my $str = ((100 - $r_min)/2 + $r_min) . "%";
    $image->string($font,
                   $origin_x - 5 - length($str) * $font->width,
                   $middle - $font->height / 2,
                   $str, $black);

    $str = $r_min . "%";
    $image->string($font,
                   $origin_x - 5 - length($str) * $font->width,
                   $origin_y - $font->height / 2,
                   $str, $black);

    return $image;
}

##################################################################
##################################################################
##################################################################

sub mk_week_uptime_gif
{
    my ($srv, $date) = @_;
    $date =~ /(\d{4})(\d{2})(\d{2})/;
    my ($y, $m, $d) = ($1, $2, $3);

    # Read uptime% for this week
    my @stats;
    for my $i (0 .. 6) { $stats[$i] = -1 }
    my $day = timelocal(0, 0, 0, $d, $m-1, $y-1900);
    my $min = 100;
    foreach my $i (0 .. 6)
    {
        my ($d, $m, $y) = (localtime($day))[3 .. 5];
        $m++; $y +=1900;
        my $fn = sprintf("$UMDIR/data/services/$srv/daily/%04d%02d%02d", $y, $m, $d);
        if (-f $fn)
        {
            open DAILY, $fn or logdie "Cannot open file $fn: $!";
            <DAILY>;  # lose array
            chomp(my $stats = <DAILY>);
            close DAILY;

            my ($type, $open, $down) = split /:/, $stats;
            my $perc = ($open == 0) ? '100.000' : sprintf("%.03f", (($open - $down)/$open) * 100);
            $stats[$i] = $perc;
            $min = $perc if $perc < $min;
        }
        $day += 24*60*60;
    }
    my $r_min = int($min) - int($min) % 5;
    $r_min -= 5 if $r_min == $min;
    $r_min = 0 if $r_min < 0;

    my $image = init_image("Uptime week starting $y/$m/$d", $r_min);
    my $pix_per_unit = ($origin_y - $top_margin)/(100 - $r_min);;
    my $block_width = ($width - $right_margin - $origin_x) / 8;
    $day = timelocal(0, 0, 0, $d, $m-1, $y-1900);
    foreach my $i (0 .. 6)
    {
        if ($stats[$i] != -1)
        {
            my $block_height = ($stats[$i] - $r_min) * $pix_per_unit;
            $image->filledRectangle($block_width * $i + 5 + $block_width/2 + $origin_x, $origin_y - $block_height,
                                    $block_width * ($i + 1) - 5 + $block_width/2 + $origin_x, $origin_y - 1, $green);
        }
        $image->filledRectangle($block_width * ($i + 1) + $origin_x, $origin_y - 1,
                                $block_width * ($i + 1) + $origin_x, $origin_y + 1, $black);

        if ($i % 2 == 0)
        {
            $image->filledRectangle($block_width * ($i + 1) + $origin_x, $origin_y - 3,
                                    $block_width * ($i + 1) + $origin_x, $origin_y + 3, $black);

            my ($d, $m, $y) = (localtime($day))[3 .. 5];
            $m++; $y +=1900;
            my $str = sprintf("%02d/%02d", $m, $d);
            $image->string($font,
                           $block_width * ($i + 1) + $origin_x - length($str) * ($font->width) / 2,
                           $origin_y + 5,
                           $str, $black);
        }
        $day += 24*60*60;
    }

    print STDOUT "Pragma: no-cache\n";
    print STDOUT "Expires: " . mk_expiry(time+5*60) . "\n";
    print STDOUT "Content-type: image/gif\n\n";
    print STDOUT $image->gif;
}

##################################################################
##################################################################
##################################################################

sub mk_month_uptime_gif
{
    my ($srv, $date) = @_;
    $date =~ /(\d{4})(\d{2})(\d{2})/;
    my ($y, $m, $d) = ($1, $2, $3);

    my @stats;
    for my $i (0 .. 30) { $stats[$i] = -1 }
    my $min = 100;
    my $day = timelocal(0, 0, 0, $d, $m-1, $y-1900);
    foreach my $i (0 .. 30)
    {
        my ($d, $m, $y) = (localtime($day))[3 .. 5];
        $m++; $y +=1900;
        my $fn = sprintf("$UMDIR/data/services/$srv/daily/%04d%02d%02d", $y, $m, $d);
        if (-f $fn)
        {
            open DAILY, $fn or logdie "Cannot open file $fn: $!";
            <DAILY>;  # lose array
            chomp(my $stats = <DAILY>);
            close DAILY;

            my ($type, $open, $down) = split /:/, $stats;
            my $perc = ($open == 0) ? '100.000' : sprintf("%.03f", (($open - $down)/$open) * 100);
            $stats[$i] = $perc;
            $min = $perc if $perc < $min;
        }
        $day += 24*60*60;
    }
    my $r_min = int($min) - int($min) % 5;
    $r_min -= 5 if $r_min == $min;
    $r_min = 0 if $r_min < 0;

    my $image = init_image("Uptime month starting $y/$m/$d", $r_min);
    my $pix_per_unit = ($origin_y - $top_margin)/(100 - $r_min);;
    my $block_width = ($width - $right_margin - $origin_x) / 32;
    $day = timelocal(0, 0, 0, $d, $m-1, $y-1900);
    foreach my $i (0 .. 30)
    {
        if ($stats[$i] != -1)
        {
            my $block_height = ($stats[$i] - $r_min) * $pix_per_unit;
            $image->filledRectangle($block_width * $i + 7 + $block_width/2 + $origin_x, $origin_y - $block_height,
                                    $block_width * ($i + 1) + 3 + $block_width/2 + $origin_x, $origin_y - 1, $green);
        }
        $image->filledRectangle($block_width * ($i + 1) + 5 + $origin_x, $origin_y - 1,
                                $block_width * ($i + 1) + 5 + $origin_x, $origin_y + 1, $black);

        if ($i % 5 == 0)
        {
            $image->filledRectangle($block_width * ($i + 1) + 5 + $origin_x, $origin_y - 3,
                                    $block_width * ($i + 1) + 5 + $origin_x, $origin_y + 3, $black);

            my ($d, $m, $y) = (localtime($day))[3 .. 5];
            $m++; $y +=1900;
            my $str = sprintf("%02d/%02d", $m, $d);
            $image->string($font,
                           $block_width * ($i + 1) + 5 + $origin_x - length($str) * ($font->width) / 2,
                           $origin_y + 5,
                           $str, $black);
        }
        $day += 24*60*60;
    }

    print STDOUT "Pragma: no-cache\n";
    print STDOUT "Expires: " . mk_expiry(time+5*60) . "\n";
    print STDOUT "Content-type: image/gif\n\n";
    print STDOUT $image->gif;
}

##################################################################
##################################################################
##################################################################

sub mk_year_uptime_gif
{
    my ($srv, $date) = @_;
    $date =~ /(\d{4})(\d{2})(\d{2})/;
    my ($y, $m, $d) = ($1, $2, $3);

    my @stats;
    for my $i (0 .. 364) { $stats[$i] = -1 }
    my $min = 100;
    my $day = timelocal(0, 0, 0, $d, $m-1, $y-1900);
    foreach my $i (0 .. 364)
    {
        my ($d, $m, $y) = (localtime($day))[3 .. 5];
        $m++; $y +=1900;
        my $fn = sprintf("$UMDIR/data/services/$srv/daily/%04d%02d%02d", $y, $m, $d);
        if (-f $fn)
        {
            open DAILY, $fn or logdie "Cannot open file $fn: $!";
            <DAILY>;  # lose array
            chomp(my $stats = <DAILY>);
            close DAILY;

            my ($type, $open, $down) = split /:/, $stats;
            my $perc = ($open == 0) ? 100 : ((($open - $down)/$open) * 100);
            $stats[$i] = $perc;
            $min = $perc if $perc < $min;
        }
        $day += 24*60*60;
    }
    my $r_min = int($min) - int($min) % 5;
    $r_min -= 5 if $r_min == $min;
    $r_min = 0 if $r_min < 0;

    my $image = init_image("Uptime month starting $y/$m/$d", $r_min);
    my $pix_per_unit = ($origin_y - $top_margin)/(100 - $r_min);;
    my $block_width = 1;
    $day = timelocal(0, 0, 0, $d, $m-1, $y-1900);
    foreach my $i (0 .. 364)
    {
        if ($stats[$i] != -1)
        {
            my $block_height = ($stats[$i] - $r_min) * $pix_per_unit;
            $image->filledRectangle($i + 30 + $origin_x, $origin_y - $block_height,
                                    $i + 30 + $origin_x, $origin_y - 1, $green);
        }

        if ($i % 14 == 0)
        {
            $image->filledRectangle($block_width * ($i + 1) + 30 + $origin_x, $origin_y - 1,
                                    $block_width * ($i + 1) + 30 + $origin_x, $origin_y + 1, $black);
        }

        if ($i % 70 == 0)
        {
            $image->filledRectangle($block_width * ($i + 1) + 30 + $origin_x, $origin_y - 3,
                                    $block_width * ($i + 1) + 30 + $origin_x, $origin_y + 3, $black);

            my ($d, $m, $y) = (localtime($day))[3 .. 5];
            $m++; $y +=1900;
            my $str = sprintf("%02d/%02d", $m, $d);
            $image->string($font,
                           $block_width * ($i + 1) + 30 + $origin_x - length($str) * ($font->width) / 2,
                           $origin_y + 5,
                           $str, $black);
        }
        $day += 24*60*60;
    }

    print STDOUT "Pragma: no-cache\n";
    print STDOUT "Expires: " . mk_expiry(time+5*60) . "\n";
    print STDOUT "Content-type: image/gif\n\n";
    print STDOUT $image->gif;
}

##################################################################
##################################################################
##################################################################

sub draw_img
{
    my $q = shift;

    if (verify_access($q, $q->param('srv')))
    {
        if ($q->param('week'))
        {
            mk_week_uptime_gif($q->param('srv'), $q->param('week'));
        }
        if ($q->param('month'))
        {
            mk_month_uptime_gif($q->param('srv'), $q->param('month'));
        }
        if ($q->param('year'))
        {
            mk_year_uptime_gif($q->param('srv'), $q->param('year'));
        }
    }
}

##################################################################
##################################################################
##################################################################

sub nc_user
{
    my ($q, $user) = @_;
    my $nc_user = $q->param('nc_user');

    open SRVS, "$services_file" or logdie "Cannot open $services_file: $!\n";
    my @all_srvs= <SRVS>;
    close SRVS;

    chomp(@all_srvs); my (%srvs, @srvs); $srvs{"ALL"} = "[ ALL ]"; $srvs[0] = "ALL";
    foreach my $srv (@all_srvs)
    {
        my ($srvid, $srvname) = split /:/, $srv;
        push @srvs, $srvid;
        $srvs{$srvid} = $srvname;
    }

    open PWD, "$pwd_file" or logdie "Cannot open $pwd_file: $!\n"; my @all_pwd = <PWD>; close PWD;
    chomp @all_pwd; my @users;
    foreach my $pwd (@all_pwd) { push @users, (split(/:/, $pwd))[0]; }

    my $script = '
       function do_cancel()
       {
           document.forms[0].cancelled.value = 1
           return 1
       }
       function set_submit()
       {
           document.forms[0].do_submit.value = 1
           return 1
       }';

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics - User details',
                         -vlink   => '#0000ff',
                         -style   => $style_right,
                         -script  => $script),
          $q->startform,
          $q->hidden( { -name => 'aframe',    -default => 'detail' } ),
          $q->hidden( { -name => 'nc_user',   -default => '0' } ),
          $q->hidden( { -name => 'cancelled', -default => '0' } ),
          $q->hidden( { -name => 'do_submit', -default => '0' } );

    if ($q->param('cancelled'))
    {
        print $q->b('Action cancelled'),
              $q->endform,
              $q->end_html;
        return 1;
    }

    if ($nc_user eq "add")
    {
        ###########################
        # User add
        ###########################
        if ($q->param('do_submit'))
        {
            if ($q->param("username") !~ /^[a-zA-Z0-9_-]+$/)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Username Can only contain a-z, A-Z, - and _"));
                goto REPRINT;
            }
            my $user = $q->param("username");
            if (grep /^$user$/, @users)
            {
                print $q->p( { -style => 'color: red' }, $q->b("User already exists"));
                goto REPRINT;
            }
            if ((not $q->param("password1")) || $q->param("password1") ne $q->param("password2"))
            {
                print $q->p( { -style => 'color: red' }, $q->b("No password, or passwords are not equal"));
                goto REPRINT;
            }
            if (not $q->param("allowed_services"))
            {
                print $q->p( { -style => 'color: red' }, $q->b("Choose at least one service"));
                goto REPRINT;
            }
            my $passwd = crypt($q->param('password1'),
                               join('', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
            my $type = ($q->param("admin")) ? "admin" : "user";
            open PWD, ">>$pwd_file" or logdie "Cannot open $pwd_file: $!\n";
            print PWD "$user:$passwd:$type:" . join(",", $q->param("allowed_services")) . "\n";
            close PWD;
            print $q->b('User added'),
                  $q->endform,
                  $q->end_html;
            return 1;
        }

        REPRINT:
        print $q->big("Add user"),
              $q->table({ -border => '0', -width => '100%' },
                $q->Tr(
                  $q->td('Username'),
                  $q->td($q->textfield(-name => 'username', -default => '', -size => 20))
                ),
                $q->Tr(
                  $q->td('Password'),
                  $q->td($q->password_field(-name => 'password1', -default => '', -size => 20))
                ),
                $q->Tr(
                  $q->td('Repeat password'),
                  $q->td($q->password_field(-name => 'password2', -default => '', -size => 20))
                ),
                $q->Tr(
                  $q->td('User type'),
                  $q->td($q->checkbox(-name    => 'admin',
                                      -checked => '',
                                      -value   => 'admin',
                                      -label   => 'Administrator'))
                ),
                $q->Tr(
                  $q->td('Allow acces to the services:'),
                  $q->td($q->scrolling_list(-name     => 'allowed_services',
                                            -values   => \@srvs,
                                            -size     => 10,
                                            -multiple => 'true',
                                            -labels   => \%srvs))
                )
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Add',
                            -value   => 'Add',
                            -onClick => 'set_submit()' } );
    } elsif ($nc_user eq "change")
    {
        ###########################
        # User change
        ###########################
        if ($q->param('do_submit'))
        {
            my $user = $q->param("username");
            if ($q->param("password1") ne $q->param("password2"))
            {
                print $q->p( { -style => 'color: red' }, $q->b("Passwords are not equal"));
                goto REPRINT2;
            }
            if (not $q->param("allowed_services"))
            {
                print $q->p( { -style => 'color: red' }, $q->b("Choose at least one service"));
                goto REPRINT2;
            }
            open PWDN, ">>$pwd_file.new" or logdie "Cannot open $pwd_file.new: $!\n";
            my $passwd;
            foreach my $pwd (@all_pwd)
            {
                print PWDN "$pwd\n" if ((split(/:/, $pwd))[0] ne $user);
                $passwd = (split(/:/, $pwd))[1] if ((split(/:/, $pwd))[0] eq $user);
            }
            if ($q->param('password1'))
            {
                $passwd = crypt($q->param('password1'),
                               join('', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
            }
            my $type = ($q->param("admin")) ? "admin" : "user";
            print PWDN "$user:$passwd:$type:" .  join(",", $q->param("allowed_services")) . "\n";
            close PWDN;
            rename("$pwd_file.new", "$pwd_file") or logdie "Cannot rename  .users: $!\n";
            print $q->b('User changed'),
                  $q->endform,
                  $q->end_html;
            return 1;
        }

        REPRINT2:
        @users = grep(!/^anonymous$/, @users);
        my $username = $q->param('username') ? $q->param('username') : "$users[0]";
        my $select =  $q->popup_menu(-name     => 'username',
                                     -values   => \@users,
                                     -default  => $username,
                                     -onChange => 'javascript:submit()');

        my (@user_srvs, $passwd, $type);
        foreach my $pwd (@all_pwd)
        {
            if ((split(/:/, $pwd))[0] eq $username)
            {
                my $user_srvs;
                ($type, $user_srvs) = (split(/:/, $pwd))[2, 3];
                @user_srvs = split(/,/, $user_srvs);
                last;
            }
        }

        print $q->big("Edit user"),
              $q->table({ -border => '0', -width => '100%' },
                $q->Tr(
                  $q->td('Username'),
                  $q->td($select)
                ),
                $q->Tr(
                  $q->td('Password'),
                  $q->td($q->password_field(-name => 'password1', -default => '', -size => 20))
                ),
                $q->Tr(
                  $q->td('Repeat password'),
                  $q->td($q->password_field(-name => 'password2', -default => '', -size => 20))
                ),
                $q->Tr(
                  $q->td('User type'),
                  $q->td($q->checkbox(-name     => 'admin',
                                      -checked  => ($type eq 'admin') ? 'admin' : '',
                                      -override => 1,
                                      -value    => 'admin',
                                      -label    => 'Administrator'))
                ),
                $q->Tr(
                  $q->td('Allow acces to the services:'),
                  $q->td($q->scrolling_list(-name     => 'allowed_services',
                                            -values   => \@srvs,
                                            -defaults => \@user_srvs,
                                            -override => 1,
                                            -size     => 10,
                                            -multiple => 'true',
                                            -labels   => \%srvs))
                )
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Change',
                            -value   => 'Change',
                            -onClick => 'set_submit()' } );
    } elsif ($nc_user eq "remove")
    {
        ###########################
        # User remove
        ###########################
        if ($q->param('do_submit'))
        {
            my $user = $q->param("username");

            open PWDN, ">>$pwd_file.new" or logdie "Cannot open $pwd_file.new: $!\n";
            foreach my $pwd (@all_pwd) { print PWDN "$pwd\n" if ((split(/:/, $pwd))[0] ne $user); }
            close PWDN;
            rename("$pwd_file.new", "$pwd_file") or logdie "Cannot rename  .users: $!\n";
            print $q->b('User deleted'),
                  $q->endform,
                  $q->end_html;
            return 1;
        }

        @users = grep(!/^anonymous$/, @users);
        my $username = $q->param('username') ? $q->param('username') : "$users[0]";
        my $select =  $q->popup_menu(-name     => 'username',
                                     -values   => \@users,
                                     -default  => $username,
                                     -onChange => 'javascript:submit()');

        print $q->big("Remove user"),
              $q->table({ -border => '0', -width => '100%' },
                $q->Tr(
                  $q->td('Username'),
                  $q->td($select)
                )
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Remove',
                            -value   => 'Remove',
                            -onClick => 'set_submit()' } );
    } elsif ($nc_user eq "anon")
    {
        ###########################
        # User anon
        ###########################
        if ($q->param('do_submit'))
        {
            my $allowed = $q->param("anon_allowed");
            if ($allowed && not $q->param("allowed_services"))
            {
                print $q->p( { -style => 'color: red' }, $q->b("Choose at least one service"));
                goto REPRINT3;
            }
            open PWDN, ">>$pwd_file.new" or logdie "Cannot open $pwd_file.new: $!\n";
            foreach my $pwd (@all_pwd) { print PWDN "$pwd\n" if ((split(/:/, $pwd))[0] ne "anonymous") }
            print PWDN "anonymous::anon:" . join(",", $q->param("allowed_services")) . "\n" if $allowed;
            close PWDN;
            rename("$pwd_file.new", "$pwd_file") or logdie "Cannot rename  .users: $!\n";
            print $q->b('Anonymous changed'),
                  $q->endform,
                  $q->end_html;
            return 1;
        }

        REPRINT3:
        my $allowed = grep(/^anonymous$/, @users);
        my $chkbox = $q->checkbox(-name    => 'anon_allowed',
                                  -checked => $allowed ? 'checked' : '',
                                  -value   => 'allowed',
                                  -label   => 'Access allowed');

        my (@user_srvs, $passwd);
        foreach my $pwd (@all_pwd)
        {
            if ((split(/:/, $pwd))[0] eq "anonymous")
            {
                my $user_srvs;
                $user_srvs = (split(/:/, $pwd))[3];
                @user_srvs = split(/,/, $user_srvs);
                last;
            }
        }

        print $q->big("Anonymous user"),
              $q->table({ -border => '0', -width => '100%' },
                $q->Tr(
                  $q->td('Anonymous access'),
                  $q->td($chkbox)
                ),
                $q->Tr(
                  $q->td('Allow acces to the services:'),
                  $q->td($q->scrolling_list(-name     => 'allowed_services',
                                            -values   => \@srvs,
                                            -defaults => \@user_srvs,
                                            -override => 1,
                                            -size     => 10,
                                            -multiple => 'true',
                                            -labels   => \%srvs))
                )
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Change',
                            -value   => 'Change',
                            -onClick => 'set_submit()' } );
    }

    print $q->endform,
          $q->end_html;

    return 1;
}

##################################################################
##################################################################
##################################################################

sub nc_check
{
    my ($q, $user) = @_;
    my $nc_check = $q->param('nc_check');

    open CHKS, "$checks_file" or logdie "Cannot open $checks_file: $!\n";
    chomp(my @all_checks= <CHKS>);
    close CHKS;
    my @checks;
    foreach my $chk (@all_checks) { push @checks, (split(/:/, $chk))[0]; }

    my $script = '
       function do_cancel()
       {
           document.forms[0].cancelled.value = 1
           return 1
       }
       function set_submit()
       {
           document.forms[0].do_submit.value = 1
           return 1
       }';

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics - Check details',
                         -vlink   => '#0000ff',
                         -style   => $style_right,
                         -script  => $script),
          $q->startform,
          $q->hidden( { -name => 'aframe',    -default => 'detail' } ),
          $q->hidden( { -name => 'nc_check',  -default => '0' } ),
          $q->hidden( { -name => 'cancelled', -default => '0' } ),
          $q->hidden( { -name => 'do_submit', -default => '0' } );

    if ($q->param('cancelled'))
    {
        print $q->b('Action cancelled'),
              $q->endform,
              $q->end_html;
        return 1;
    }

    if ($nc_check eq "add")
    {
        ###########################
        # Check add
        ###########################
        if ($q->param('do_submit'))
        {
            if ($q->param("checkid") !~ /^[a-zA-Z0-9_-]+$/)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Check id can only contain a-z, A-Z, - and _"));
                goto REPRINT;
            }
            my $check = $q->param("checkid");
            if (grep /^$check$/, @checks)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Check already exists"));
                goto REPRINT;
            }
            my $descr = $q->param("descr"); $descr = '' if not $descr;
            if ($descr =~ /:/)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Colon (:) not allowed in description"));
                goto REPRINT;
            }
            if (not $q->param("script"))
            {
                print $q->p( { -style => 'color: red' }, $q->b("You must supply a script name"));
                goto REPRINT;
            }
            my $script = $q->param("script");
            open CHKS, ">>$checks_file" or logdie "Cannot open $checks_file: $!\n";
            print CHKS "$check:$descr:$script\n";
            close CHKS;
            print $q->b('Check added'),
                  $q->p,
                  $q->b("Note: The check has been added in the Uptimetrics administration;
                         you are responsible for providing the actual script in the directory
                         $UMDIR/data/checks.<br>The script should echo 'up' if the service is
                         availabe, 'down' otherwise.<br>A ping.ksh and proc.ksh are supplied as
                         example scripts in that directory."),
                  $q->endform,
                  $q->end_html;
            return 1;
        }

        REPRINT:
        print $q->big("Add check"),
              $q->table({ -border => '0', -width => '100%' },
                $q->Tr(
                  $q->td('Check id'),
                  $q->td($q->textfield(-name => 'checkid', -default => '', -size => 20))
                ),
                $q->Tr(
                  $q->td('Description'),
                  $q->td($q->textfield(-name => 'descr', -default => '', -size => 50))
                ),
                $q->Tr(
                  $q->td('Script'),
                  $q->td($q->textfield(-name => 'script', -default => '', -size => 20))
                )
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Add',
                            -value   => 'Add',
                            -onClick => 'set_submit()' } );
    } elsif ($nc_check eq "change")
    {
        ###########################
        # Check change
        ###########################
        if ($q->param('do_submit'))
        {
            my $check = $q->param("checkid");
            my $descr = $q->param("descr"); $descr = '' if not $descr;
            if ($descr =~ /:/)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Colon (:) not allowed in description"));
                goto REPRINT2;
            }
            if (not $q->param("script"))
            {
                print $q->p( { -style => 'color: red' }, $q->b("You must supply a script name"));
                goto REPRINT2;
            }
            my $script = $q->param("script");
            open CHKSN, ">>$checks_file.new" or logdie "Cannot open $checks_file.new: $!\n";
            foreach my $chk (@all_checks)
            {
                if ((split(/:/, $chk))[0] ne $check)
                 { print CHKSN "$chk\n"; }
                 else { print CHKSN "$check:$descr:$script\n"; }
            }
            close CHKSN;
            rename("$checks_file.new", $checks_file) or logdie "Cannot rename checks.new: $!\n";
            print $q->b('Check changed'),
                  $q->endform,
                  $q->end_html;
            return 1;
        }

        REPRINT2:
        my $chkn = $q->param('checkid') ? $q->param('checkid') : "$checks[0]";
        my $select =  $q->popup_menu(-name     => 'checkid',
                                     -values   => \@checks,
                                     -default  => $chkn,
                                     -onChange => 'javascript:submit()');

        my ($descr, $script);
        foreach my $chk (@all_checks)
        {
            if ((split(/:/, $chk))[0] eq $chkn)
            {
                ($descr, $script) = (split(/:/, $chk))[1, 2];
                last;
            }
        }

        print $q->big("Edit check"),
              $q->table({ -border => '0', -width => '100%' },
                $q->Tr(
                  $q->td('Check id'),
                  $q->td($select)
                ),
                $q->Tr(
                  $q->td('Description'),
                  $q->td($q->textfield(-name => 'descr', -default => $descr, -size => 50, -override => 1))
                ),
                $q->Tr(
                  $q->td('Script'),
                  $q->td($q->textfield(-name => 'script', -default => $script, -size => 20, -override => 1))
                )
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Change',
                            -value   => 'Change',
                            -onClick => 'set_submit()' } );
    } elsif ($nc_check eq "remove")
    {
        ###########################
        # Check remove
        ###########################
        if ($q->param('do_submit'))
        {
            my $check = $q->param("checkid");

            open SRVS, "$services_file" or logdie "Cannot open $services_file: $!\n";
            my @all_srvs= <SRVS>;
            close SRVS;
            foreach my $srv (@all_srvs)
            {
                my $srvdir = (split(/:/, $srv))[0];
                open CHK, "$UMDIR/data/services/$srvdir/check"
                     or logdie "Cannot open $UMDIR/data/services/$srvdir/check: $!\n";
                chomp(my $chk = <CHK>);
                close CHK;
                if ((split(/:/, $chk))[1] eq $check)
                {
                    print $q->p( { -style => 'color: red' }, $q->b("Check is still in use by a service"));
                    goto REPRINT3;
                }
            }

            open CHKS, ">>$checks_file.new" or logdie "Cannot open $checks_file.new: $!\n";
            foreach my $chk (@all_checks) { print CHKS "$chk\n" if ((split(/:/, $chk))[0] ne $check); }
            close CHKS;
            rename("$checks_file.new", "$checks_file") or logdie "Cannot rename  checks.new: $!\n";
            print $q->b('Check deleted'),
                  $q->endform,
                  $q->end_html;
            return 1;
        }

        REPRINT3: 
        my $chkn = $q->param('checkid') ? $q->param('checkid') : "$checks[0]";
        my $select =  $q->popup_menu(-name     => 'checkid',
                                     -values   => \@checks,
                                     -default  => $chkn,
                                     -onChange => 'javascript:submit()');

        print $q->big("Remove check"),
              $q->table({ -border => '0', -width => '100%' },
                $q->Tr(
                  $q->td('Check id'),
                  $q->td($select)
                )
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Remove',
                            -value   => 'Remove',
                            -onClick => 'set_submit()' } );
    }

    print $q->endform,
          $q->end_html;

    return 1;
}

##################################################################
##################################################################
##################################################################

sub nc_service
{
    my ($q, $user) = @_;
    my $nc_service = $q->param('nc_service');

    open SRVS, "$services_file" or logdie "Cannot open $services_file: $!\n";
    chomp(my @all_srvs= <SRVS>);
    close SRVS;
    my (%srvs, @srvs);
    foreach my $srv (@all_srvs)
    {
        my ($srvid, $srvname) = split /:/, $srv;
        push @srvs, $srvid;
        $srvs{$srvid} = $srvname;
    }

    open CHKS, "$checks_file" or logdie "Cannot open $checks_file: $!\n";
    chomp(my @all_checks= <CHKS>);
    close CHKS;
    my @checks;
    foreach my $chk (@all_checks) { push @checks, (split(/:/, $chk))[0]; }

    my $script = '
       function do_cancel()
       {
           document.forms[0].cancelled.value = 1
           return 1
       }
       function set_submit()
       {
           document.forms[0].do_submit.value = 1
           return 1
       }
       function set_del(which)
       {
           document.forms[0].deleted.value = which
           return 1
       }
       function set_add(which)
       {
           document.forms[0].added.value = which
           return 1
       }';

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics - Check details',
                         -vlink   => '#0000ff',
                         -style   => $style_right,
                         -script  => $script),
          $q->startform,
          $q->hidden( { -name => 'aframe',      -default => 'detail' } ),
          $q->hidden( { -name => 'nc_service',  -default => '0' } ),
          $q->hidden( { -name => 'cancelled',   -default => '0' } ),
          $q->hidden( { -name => 'do_submit',   -default => '0' } );

    if ($q->param('cancelled'))
    {
        print $q->b('Action cancelled'),
              $q->endform,
              $q->end_html;
        return 1;
    }

    if ($nc_service eq "add")
    {
        ###########################
        # Service add
        ###########################
        if ($q->param('do_submit'))
        {
            my $srv_id = $q->param("srv_id");
            if ($q->param("srv_id") !~ /^[a-zA-Z0-9_-]+$/)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Service id can only contain a-z, A-Z, - and _"));
                goto REPRINT;
            }
            if (grep /^$srv_id$/, @srvs)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Service already exists"));
                goto REPRINT;
            }
            my $descr = $q->param("descr");
            if (not $q->param("descr"))
            {
                print $q->p( { -style => 'color: red' }, $q->b("You must supply a description"));
                goto REPRINT;
            }
            if ($descr =~ /:/)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Colon (:) not allowed in description"));
                goto REPRINT;
            }
            my $check = $q->param("check");
            if ($check eq "<select a check>")
            {
                print $q->p( { -style => 'color: red' }, $q->b("You must choose a check"));
                goto REPRINT;
            }
            my $params = $q->param("params"); $params = '' if not $params;
            my $client = $q->param("client");
            if (not $q->param("client"))
            {
                print $q->p( { -style => 'color: red' }, $q->b("You must choose a machine on which to run the check"));
                goto REPRINT;
            }

            open SRVS, ">>$services_file" or logdie "Cannot open $services_file: $!\n";
            print SRVS "$srv_id:$descr\n";
            close SRVS;
            mkdir("$UMDIR/data/services/$srv_id", 0755)
                 or logdie "Cannot mkdir $UMDIR/data/services/$srv_id: $!\n";
            mkdir("$UMDIR/data/services/$srv_id/daily", 0755)
                 or logdie "Cannot mkdir $UMDIR/data/services/$srv_id/daily: $!\n";
            mkdir("$UMDIR/data/services/$srv_id/weekly", 0755)
                 or logdie "Cannot mkdir $UMDIR/data/services/$srv_id/weekly: $!\n";
            mkdir("$UMDIR/data/services/$srv_id/monthly", 0755)
                 or logdie "Cannot mkdir $UMDIR/data/services/$srv_id/monthly: $!\n";
            mkdir("$UMDIR/data/services/$srv_id/reasons", 0755)
                 or logdie "Cannot mkdir $UMDIR/data/services/$srv_id/reasons: $!\n";
            mkdir("$UMDIR/data/clients/$client", 0755);
            open CHK, ">$UMDIR/data/services/$srv_id/check"
                 or logdie "Cannot open $UMDIR/data/services/$srv_id/check: $!\n";
            print CHK "$client:$check:$params\n";
            close CHK;
            open SCHED, ">$UMDIR/data/services/$srv_id/schedule"
                 or logdie "Cannot open $UMDIR/data/services/$srv_id/schedule: $!\n";
            print SCHED "s:u:-:-:-:-:0,1,2,3,4,5,6\n";
            close SCHED;
            my $dist_ret = `$UMDIR/distribute.pl $srv_id 2>&1`;
            if ($dist_ret eq "")
            {
                print $q->b("Service added. Make sure that umclient.ksh is started every minute
                             from cron on machine $client");
            }
            else
            {
                print $q->b("Service added, but there was a problem during copying configuration
                             files to machine $client:"),
                      $q->p,
                      $q->tt($dist_ret),
                      $q->p,
                      $q->b("Please correct the problem, and run distribute.pl from the command line,
                             or click 'Edit service', select this service, and click 'Change'");
            }
            print $q->endform,
                  $q->end_html;
            return 1;
        }

        REPRINT:
        unshift(@checks, "<select a check>");
        my $select =  $q->popup_menu(-name     => 'check',
                                     -values   => \@checks,
                                     -default  => $checks[0]);

        print $q->big("Add service"),
              $q->table({ -border => '0', -width => '100%' },
                $q->Tr(
                  $q->td('Service id'),
                  $q->td($q->textfield(-name => 'srv_id', -default => '', -size => 20))
                ),
                $q->Tr(
                  $q->td('Service name'),
                  $q->td($q->textfield(-name => 'descr', -default => '', -size => 50))
                ),
                $q->Tr(
                  $q->td('Check to use'),
                  $q->td($select)
                ),
                $q->Tr(
                  $q->td('Parameter(s) for the check'),
                  $q->td($q->textfield(-name => 'params', -default => '', -size => 50))
                ),
                $q->Tr(
                  $q->td('Machine the check must run on'),
                  $q->td($q->textfield(-name => 'client', -default => '', -size => 20))
                )
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Add',
                            -value   => 'Add',
                            -onClick => 'set_submit()' } );
    } elsif ($nc_service eq "change")
    {
        ###########################
        # Service change
        ###########################
        if ($q->param('do_submit'))
        {
            my $srv_id = $q->param("srv_id");
            my $descr = $q->param("descr");
            if (not $q->param("descr"))
            {
                print $q->p( { -style => 'color: red' }, $q->b("You must supply a description"));
                goto REPRINT2;
            }
            if ($descr =~ /:/)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Colon (:) not allowed in description"));
                goto REPRINT2;
            }
            my $check = $q->param("check");
            my $params = $q->param("params");
            my $client = $q->param("client");
            if (not $client)
            {
                print $q->p( { -style => 'color: red' }, $q->b("You must choose a machine on which to run the check"));
                goto REPRINT2;
            }
            open SRVS, ">>$services_file.new" or logdie "Cannot open $services_file.new: $!\n";
            foreach my $srv (@all_srvs)
            {
                if ((split(/:/, $srv))[0] ne $srv_id)
                { print SRVS "$srv\n"; }
                else { print SRVS "$srv_id:$descr\n"; }
            }
            close SRVS;
            rename("$services_file.new", $services_file) or logdie "Cannot rename services.new: $!\n";
            open CHK, ">$UMDIR/data/services/$srv_id/check"
                 or logdie "Cannot open $UMDIR/data/services/$srv_id/check: $!\n";
            print CHK "$client:$check:$params\n";
            close CHK;
            my $dist_ret = `$UMDIR/distribute.pl $srv_id 2>&1`;
            if ($dist_ret eq "")
            {
                print $q->b("Service changed. Make sure that umclient.ksh is started every minute
                             from cron on machine $client");
            }
            else
            {
                print $q->b("Service changed, but there was a problem during copying configuration
                             files to machine $client:"),
                      $q->p,
                      $q->tt($dist_ret),
                      $q->p,
                      $q->b("Please correct the problem, and run distribute.pl from the command line,
                             or click 'Edit service', select this service, and click 'Change'");
            }
            print $q->endform,
                  $q->end_html;
            return 1;
        }

        REPRINT2:
        my $srv_id = $q->param('srv_id') ? $q->param('srv_id') : "$srvs[0]";
        my $select =  $q->popup_menu(-name     => 'srv_id',
                                     -values   => \@srvs,
                                     -default  => $srv_id,
                                     -onChange => 'javascript:submit()');

        my ($descr, $check, $client, $params);
        $descr = $srvs{$srv_id};
        open CHK, "$UMDIR/data/services/$srv_id/check"
             or logdie "Cannot open $UMDIR/data/services/$srv_id/check: $!\n";
        my $ln = <CHK>;
        ($client, $check, $params) = split /:/, $ln;

        my $chk_select =  $q->popup_menu(-name     => 'check',
                                         -values   => \@checks,
                                         -override => 1,
                                         -default  => $check);

        print $q->big("Edit service"),
              $q->table({ -border => '0', -width => '100%' },
                $q->Tr(
                  $q->td('Service id'),
                  $q->td($select)
                ),
                $q->Tr(
                  $q->td('Service name'),
                  $q->td($q->textfield(-name => 'descr', -default => $descr, -size => 50, -override => 1))
                ),
                $q->Tr(
                  $q->td('Check to use'),
                  $q->td($chk_select)
                ),
                $q->Tr(
                  $q->td('Parameters for the check'),
                  $q->td($q->textfield(-name => 'params', -default => $params, -size => 50, -override => 1))
                ),
                $q->Tr(
                  $q->td('Machine the check must run on'),
                  $q->td($q->textfield(-name => 'client', -default => $client, -size => 20, -override => 1))
                )
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Change',
                            -value   => 'Change',
                            -onClick => 'set_submit()' } );
    } elsif ($nc_service eq "remove")
    {
        ###########################
        # Service remove
        ###########################
        if ($q->param('do_submit'))
        {
            my $srv_id = $q->param("srv_id");

            open SRVS, ">>$services_file.new" or logdie "Cannot open $services_file.new: $!\n";
            foreach my $srv (@all_srvs) { print SRVS "$srv\n" if ((split(/:/, $srv))[0] ne $srv_id); }
            close SRVS;
            rename("$services_file.new", "$services_file") or logdie "Cannot rename  services.new: $!\n";
            system("rm -rf $UMDIR/data/services/$srv_id");
            print $q->b('Service deleted'),
                  $q->endform,
                  $q->end_html;
            return 1;
        }

        my $srv_id = $q->param('srv_id') ? $q->param('srv_id') : "$srvs[0]";
        my $select =  $q->popup_menu(-name     => 'srv_id',
                                     -values   => \@srvs,
                                     -default  => $srv_id,
                                     -onChange => 'javascript:submit()');

        print $q->big("Remove service"),
              $q->table({ -border => '0', -width => '100%' },
                $q->Tr(
                  $q->td('Service id'),
                  $q->td($select)
                )
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Remove',
                            -value   => 'Remove',
                            -onClick => 'set_submit()' } );
    } elsif ($nc_service eq "sched")
    {
        ###########################
        # Service schedule
        ###########################
        if ($q->param('do_submit'))
        {
            my @all_sched = $q->param('curr_sched');
            my $srv = $q->param('srv_id');
            if (not grep /^s/, @all_sched)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Need at least one Weekly Schedule"));
            }
            else
            {
                open SCHED, ">$UMDIR/data/services/$srv/schedule"
                     or logdie "Cannot open $UMDIR/data/services/$srv/schedule: $!\n";
                print SCHED join("\n", @all_sched) . "\n";
                close SCHED;

                print $q->b('Schedule changed'),
                      $q->endform,
                      $q->end_html;
                return 1;
            }
        }

        if ((not $q->param('srv_id')) || $q->param('srv_id') eq '<choose service>')
        {
            my @s = unshift @srvs, '<choose service>';
            my $select =  $q->popup_menu(-name     => 'srv_id',
                                         -values   => \@srvs,
                                         -default  => '<choose service>',
                                         -onChange => 'javascript:submit()');
            print $q->table( { -width => '100%' },
                    $q->Tr(
                      $q->td("Choose service:"),
                      $q->td($select))),
                  $q->endform,
                  $q->end_html;

            return 1;
        }

        my $srv = $q->param('srv_id');
        my @all_sched;
        if (not $q->param('curr_sched'))
        {
            open SCHED, "$UMDIR/data/services/$srv/schedule"
                 or logdie "Cannot open $UMDIR/data/services/$srv/schedule: $!\n";
            @all_sched= <SCHED>;
            close SCHED;
            chomp(@all_sched);
            @all_sched = sort @all_sched;
        }
        else
        {
            @all_sched = $q->param('curr_sched');
        }
        my $deleted = $q->param('deleted');
        if ($deleted)
        {
            $deleted--;
            my @n_curr_sched;
            my $i = 0;
            foreach my $sched (@all_sched) { push(@n_curr_sched, $sched) if $i++ != $deleted; }
            @all_sched = @n_curr_sched;
            $all_sched[0] = 'empty' if not @all_sched;
        }
        if ($q->param('added') && $q->param('added') eq 'scheduled')
        {
            my $pstat = $q->param('s_status');
            my $ps = $q->param('s_start');
            my $pe = $q->param('s_end');
            my @pd = $q->param('s_days');
            my $po = $q->param('s_open');
            my $pc = $q->param('s_close');

            my $error = 0;
            $error = 1 if not (($ps && ($ps =~ /^\d{4}\/\d{1,2}\/\d{1,2}$/ || $ps eq "-" )) &&
                               ($pe && ($pe =~ /^\d{4}\/\d{1,2}\/\d{1,2}$/ || $pe eq "-" )) &&
                               (@pd) &&
                               ($po && ($po =~ /^\d{1,2}:\d{1,2}$/ || $po eq "-" )) &&
                               ($pc && ($pc =~ /^\d{1,2}:\d{1,2}$/ || $pc eq "-" )));
            if (not $error)
            {
                my ($status, $start, $end, $days, $open, $close);
                if ($ps eq "-") { $start = "-" }
                else
                { 
                    $ps =~ /(\d{4})\/(\d{1,2})\/(\d{1,2})/;
                    $error = 1 if $1 < 2000 || $1 > 2036 || $2 < 1 || $2 > 12 || $3 < 1 || $3 > 59;
                    $start = sprintf("%04d%02d%02d", $1, $2, $3);
                }
                if ($pe eq "-") { $end = "-" }
                else
                {
                    $pe =~ /(\d{4})\/(\d{1,2})\/(\d{1,2})/;
                    $error = 1 if $1 < 2000 || $1 > 2036 || $2 < 1 || $2 > 12 || $3 < 1 || $3 > 59;
                    $end = sprintf("%04d%02d%02d", $1, $2, $3);
                }
                $days = join ",", @pd;
                if ($po eq "-") { $open = "-" }
                else
                {
                    $po =~ /(\d{1,2}):(\d{1,2})/;
                    $error = 1 if $1 < 0 || $1 > 23 || $2 < 0 || $2 > 59;
                    $open = "$1.$2";
                }
                if ($pc eq "-") { $close = "-" }
                else
                {
                    $pc =~ /(\d{1,2}):(\d{1,2})/;
                    $error = 1 if $1 < 0 || $1 > 23 || $2 < 0 || $2 > 59;
                    $close = "$1.$2";
                }

                shift @all_sched if (not $error) && ($all_sched[0] eq "empty");
                push(@all_sched, "s:$pstat:$start:$end:$open:$close:$days") if not $error;
            }
            if ($error)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Invalid date/time/day in new schedule")),
                      $q->br,
                      "A date should be like yyyy/mm/dd (or dash (-) for no start or end date);",
                      $q->br,
                      "a time should be like hh:mm (or dash (-) for no start or end of time)",
                      $q->br,
                      "You have to select at least one day",
                      $q->p;
            }
        }
        if ($q->param('added') && $q->param('added') eq 'adhoc')
        {
            my $pstat = $q->param('a_status');
            my $ps = $q->param('a_start');
            my $po = $q->param('a_open');
            my $pc = $q->param('a_close');
            my $reason = $q->param('reason');

            my $error = 0;
            $error = 1 if not (($ps && ($ps =~ /^\d{4}\/\d{1,2}\/\d{1,2}$/ || $ps eq "-" )) &&
                               ($po && ($po =~ /^\d{1,2}:\d{1,2}$/ || $po eq "-" )) &&
                               ($pc && ($pc =~ /^\d{1,2}:\d{1,2}$/ || $pc eq "-" )));
            if (not $error)
            {
                my ($start, $open, $close);
                if ($ps eq "-") { $start = "-" }
                else
                {
                    $ps =~ /(\d{4})\/(\d{1,2})\/(\d{1,2})/;
                    $error = 1 if $1 < 2000 || $1 > 2036 || $2 < 1 || $2 > 12 || $3 < 1 || $3 > 59;
                    $start = sprintf("%04d%02d%02d", $1, $2, $3);
                }
                if ($po eq "-") { $open = "-" }
                else
                {
                    $po =~ /(\d{1,2}):(\d{1,2})/;
                    $error = 1 if $1 < 0 || $1 > 23 || $2 < 0 || $2 > 59;
                    $open = "$1.$2";
                }
                if ($pc eq "-") { $close = "-" }
                else
                {
                    $pc =~ /(\d{1,2}):(\d{1,2})/;
                    $error = 1 if $1 < 0 || $1 > 23 || $2 < 0 || $2 > 59;
                    $close = "$1.$2";
                }

                shift @all_sched if (not $error) && $all_sched[0] eq "empty";
                # No : in the reason string
                $reason =~ s/:/;/g;
                push @all_sched, "a:$pstat:$start:$start:$open:$close:0,1,2,3,4,5,6:$reason" if not $error;
            }
            if ($error)
            {
                print $q->p( { -style => 'color: red' }, $q->b("Invalid date/time in new ad hoc schedule")),
                      $q->br,
                      "A date should be like yyyy/mm/dd (or dash (-) for no date);",
                      $q->br,
                      "a time should be like hh:mm (or dash (-) for no start or end time)",
                      $q->p;
            }
        }

        my $tr_sched = "";
        my $tr_adhoc = "";
        my $nline = 1;
        foreach my $sched (@all_sched)
        {
            last if $sched eq "empty";

            my @parts = split /:/, $sched;

            $parts[2] =~ /(\d{4})(\d{2})(\d{2})/;
            my $start = ($parts[2] eq '-') ? '-' : "$1/$2/$3";
            $parts[3] =~ /(\d{4})(\d{2})(\d{2})/;
            my $end = ($parts[3] eq '-') ? '-' : "$1/$2/$3";
    
            my $days = "";
            my @days = split /,/, $parts[6];
            if (scalar(@days) == 7) { $days = 'All'; }
            else
            {
                foreach my $i (0 .. $#days) { $days[$i] = $wd[$days[$i]]; }
                $days = join(", ",  @days);
            }
    
            my $open = "";
            if ($parts[4] eq '-') { $open = '-'; }
            else { $open = sprintf("%02d:%02d", split(/\./, $parts[4])); }
    
            my $close = "";
            if ($parts[5] eq '-') { $close = '-'; }
            else { $close = sprintf("%02d:%02d", split(/\./, $parts[5])); }
    
            my $reason = "";
            $reason = $parts[7] if $parts[7];
    
            if ($parts[0] eq "s")
            {
                $tr_sched .= $q->Tr(
                   $q->td( { -class => 'white', -align => 'center' }, $parts[1] eq 'u' ? 'open' : 'closed' ),
                   $q->td( { -class => 'white', -align => 'center' }, $start ),
                   $q->td( { -class => 'white', -align => 'center' }, $end ),
                   $q->td( { -class => 'white', -align => 'center' }, $days ),
                   $q->td( { -class => 'white', -align => 'center' }, $open ),
                   $q->td( { -class => 'white', -align => 'center' }, $close ),
                   $q->td( $q->center($q->submit( { -name    => 'Delete',
                                                    -value   => 'Delete',
                                                    -onClick => "set_del($nline)" } )))
                );
            }
            else
            {
                $tr_adhoc .= $q->Tr(
                   $q->td( { -class => 'white', -align => 'center' }, $parts[1] eq 'u' ? 'open' : 'closed' ),
                   $q->td( { -class => 'white', -align => 'center' }, $start ),
                   $q->td( { -class => 'white', -align => 'center' }, $open ),
                   $q->td( { -class => 'white', -align => 'center' }, $close ),
                   $q->td( $q->center($q->submit( { -name    => 'Delete',
                                                    -value   => 'Delete',
                                                    -onClick => "set_del($nline)" } )))
                );
                $tr_adhoc .= $q->Tr(
                   $q->td( { -align => 'right' }, $q->b('Reason:')),
                   $q->td( { -colspan => 3, -class => 'white' }, $reason ),
                   $q->td("&nbsp;")
                );
            }
            $nline++;
        }

        $tr_sched .= $q->Tr(
                    $q->td( { -class => 'low' },
                            $q->center($q->popup_menu(-name     => 's_status',
                                                     -values   => [ 'u', 'd' ],
                                                     -labels   => { 'u' => 'open', 'd' => 'closed' },
                                                     -default  => 'u'))),
                    $q->td( { -class => 'low' },
                            $q->center($q->textfield(-name=>'s_start', -size => 10, -maxlength => 10))),
                    $q->td( { -class => 'low' },
                            $q->center($q->textfield(-name=>'s_end', -size => 10, -maxlength => 10))),
                    $q->td( { -class => 'low' },
                            $q->center($q->scrolling_list(-name     => 's_days',
                                                     -values   => [ 0 .. 6 ],
                                                     -defaults => [ 1 .. 5 ],
                                                     -size     => 7,
                                                     -multiple => 'true',
                                                     -labels   => \%wd))),
                    $q->td( { -class => 'low' },
                            $q->center($q->textfield(-name=>'s_open', -size => 5, -maxlength => 5))),
                    $q->td( { -class => 'low' },
                            $q->center($q->textfield(-name=>'s_close', -size => 5, -maxlength => 5))),
                    $q->td( { -class => 'low' },
                            $q->center($q->submit( { -name    => 'Add',
                                                    -value   => 'Add',
                                                    -onClick => "set_add('scheduled')" } )))
                  );

        $tr_adhoc .= $q->Tr(
                      $q->td( { -class => 'low' },
                            $q->center($q->popup_menu(-name     => 'a_status',
                                                       -values   => [ 'u', 'd' ],
                                                       -labels   => { 'u' => 'open', 'd' => 'closed' },
                                                       -default  => 'd'))),
                      $q->td( { -class => 'low' },
                            $q->center($q->textfield(-name=>'a_start', -size => 10, -maxlength => 10))),
                      $q->td( { -class => 'low' },
                            $q->center($q->textfield(-name=>'a_open', -size => 5, -maxlength => 5))),
                      $q->td( { -class => 'low' },
                            $q->center($q->textfield(-name=>'a_close', -size => 5, -maxlength => 5))),
                      $q->td( { -class => 'low' },
                            $q->center($q->submit( { -name    => 'Add',
                                           -value   => 'Add',
                                           -onClick => "set_add('adhoc')" } ))));
        $tr_adhoc .= $q->Tr(
                      $q->td( { -class => 'low' }, $q->center("Reason:")),
                      $q->td( { -class => 'low', -colspan => 3 }, 
                              $q->center($q->textfield(-name=>'reason', -size => 30, -maxlength => 30))),
                      $q->td( { -class => 'low' }, "&nbsp;"));
  
        print $q->hidden( { -name => 'curr_sched', -default => \@all_sched, -override => 1 } ),
              $q->hidden( { -name => 'srv_id', -default => '0' } ),
              $q->hidden( { -name => 'added', -default => '0', -override => 1 } ),
              $q->hidden( { -name => 'deleted', -default => '0', -override => 1 } ),
              $q->big("Edit schedule for $srv"),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Save',
                            -value   => 'Save',
                            -onClick => 'set_submit()' } ),
              $q->h2("Weekly schedule:"),
              $q->table( { -width => '100%', -border => '0' },
                $q->Tr(
                  $q->th( { -width => '14%' }, "Open/close"),
                  $q->th( { -width => '14%' }, "Start period"),
                  $q->th( { -width => '14%' }, "End period"),
                  $q->th( { -width => '14%' }, "days"),
                  $q->th( { -width => '14%' }, "Start time"),
                  $q->th( { -width => '14%' }, "End time"),
                  $q->th( { -width => '14%' }, "Action")
                ),
                $tr_sched
              ),
              $q->p,
              $q->hr,
              $q->h2("Ad hoc open/closed times:"),
              $q->table( { -width => '100%', -border => '0' },
                $q->Tr(
                  $q->th( { -width => '20%' }, "Open/close"),
                  $q->th( { -width => '20%' }, "Date"),
                  $q->th( { -width => '20%' }, "Start time"),
                  $q->th( { -width => '20%' }, "End time"),
                  $q->th( { -width => '20%' }, "Action")
                ),
                $tr_adhoc
              ),
              $q->p,
              $q->submit( { -name    => 'Cancel',
                            -value   => 'Cancel',
                            -onClick => 'do_cancel()' } ),
              $q->submit( { -name    => 'Save',
                            -value   => 'Save',
                            -onClick => 'set_submit()' } );
    }

    print $q->endform,
          $q->end_html;

    return 1;
}

##################################################################
##################################################################
##################################################################

sub af_detail
{
    my ($q, $user) = @_;

    verify_access($q, $q->param('srv'));
    return 1 if not $is_admin;

    if ($q->param('nc_user'))
    {
        nc_user($q, $user);
        return 1;
    }

    if ($q->param('nc_service'))
    {
        nc_service($q, $user);
        return 1;
    }

    if ($q->param('nc_check'))
    {
        nc_check($q, $user);
        return 1;
    }

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics - details',
                         -vlink   => '#0000ff',
                         -style   => $style_right),
          $q->end_html;

    return 1;
}

##################################################################
##################################################################
##################################################################

sub af_task
{
    my ($q, $user) = @_;

    verify_access($q, $q->param('srv'));
    return 1 if not $is_admin;

    my $script = '
       function ch_state(which)
       {
           if (which.value == "open")
               which.value = "closed"
           else
               which.value = "open"
           document.forms[0].submit()
       }
       function do_submit()
       {
           parent.close();
           return 0;
       }';

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics - Administration',
                         -vlink   => '#0000ff',
                         -style   => $style_left,
                         -script  => $script),
          $q->startform ( { -onSubmit => 'do_submit()' } ),
          $q->hidden( { -name => 'aframe', -default => 'task' } ),
          $q->hidden( { -name => 'user_state',  -default => 'closed' } ),
          $q->hidden( { -name => 'services_state',  -default => 'closed' } ),
          $q->hidden( { -name => 'checks_state',  -default => 'closed' } ),
          $q->h1('Tasks'),
          $q->br;

    my $user_state = $q->param('user_state');
    $user_state = 'closed' if not $user_state;

    my $usr = $q->ul(
                $q->li(
                  $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_user=add", -target => "detail" },
                                 "Add user"))
                ),
                $q->li(
                  $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_user=change", -target => "detail" },
                                 "Edit user"))
                ),
                $q->li(
                  $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_user=remove", -target => "detail" },
                                 "Remove user"))
                ),
                $q->li(
                  $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_user=anon", -target => "detail" },
                                 "Anonymous access"))
                )
              ) . $q->br;

    print $q->table( { -width => '100%' },
            $q->Tr(
              $q->td( { -valign => 'top' },
                      $q->a( { -href => 'javascript:ch_state(document.forms[0].user_state)' },
                             $q->img( { -src => $q->url() . "?img=$user_state.gif", -border => '0' } ))),
              $q->td( { -width => '100%' }, '<b><big>User Management</big></b>',
                     ($user_state eq 'open') ? $usr : '' )
            )
          );

    my $checks_state = $q->param('checks_state');
    $checks_state = 'closed' if not $checks_state;

    my $checks = $q->ul(
                   $q->li(
                     $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_check=add", -target => "detail" },
                                    "Add check"))
                   ),
                   $q->li(
                     $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_check=change", -target => "detail" },
                                    "Edit check"))
                   ),
                   $q->li(
                     $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_check=remove", -target => "detail" },
                                    "Remove check"))
                   )
                 ) . $q->br;

    print $q->table( { -width => '100%' },
            $q->Tr(
              $q->td( { -valign => 'top' },
                      $q->a( { -href => 'javascript:ch_state(document.forms[0].checks_state)' },
                             $q->img( { -src => $q->url() . "?img=$checks_state.gif", -border => '0' } ))),
              $q->td( { -width => '100%' }, '<b><big>Check Management</big></b>',
                     ($checks_state eq 'open') ? $checks : '' )
            )
          );

    my $services_state = $q->param('services_state');
    $services_state = 'closed' if not $services_state;

    my $services = $q->ul(
                     $q->li(
                       $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_service=add", -target => "detail" },
                                      "Add service"))
                     ),
                     $q->li(
                       $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_service=change", -target => "detail" },
                                      "Edit service"))
                     ),
                     $q->li(
                       $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_service=sched", -target => "detail" },
                                      "Edit service schedule"))
                     ),
                     $q->li(
                       $q->big($q->a( { -href => $q->url() . "?aframe=detail&nc_service=remove", -target => "detail" },
                                      "Remove service"))
                     )
                   ) . $q->br;

    print $q->table( { -width => '100%' },
            $q->Tr(
              $q->td( { -valign => 'top' },
                      $q->a( { -href => 'javascript:ch_state(document.forms[0].services_state)' },
                             $q->img( { -src => $q->url() . "?img=$services_state.gif", -border => '0' } ))),
              $q->td( { -width => '100%' }, '<b><big>Services Management</big></b>',
                     ($services_state eq 'open') ? $services : '' )
            )
          );

    print $q->p . $q->submit( { -name => 'Close admin window' } );

    print $q->endform,
          $q->end_html;

    return 1;
}

##################################################################
##################################################################
##################################################################

sub af_header
{
    my ($q, $user) = @_;

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics - Administration',
                         -vlink   => '#0000ff',
                         -style   => $style_top),
          $q->table( { -width => '100%', -border => '0', -cellspacing => '0', -cellpadding => '0' },
            $q->Tr(
              $q->td( { -align => 'center', -width => '50%' }, $q->big($q->b('Uptimetrics Administration'))),
              $q->td( { -align => 'center', -width => '50%' },
                      $q->a( { -href => 'http://www.sysman.nl', -target => "_top" } ,
                        $q->img( { -src => $q->url() . "?img=sysman.gif", -border => 0 } )))
            )
          ),
          $q->end_html;

    return 1;
}

##################################################################
##################################################################
##################################################################

sub do_aframe
{
    my $q = shift;
    my $cookie = $q->cookie(-name => 'Uptimetrics');
    $cookie = "<unknown>" if not $cookie;
    my $user = $sessions{$cookie};
    my $frame_ok = 0;
    my $frame = $q->param('aframe');

    if (! $user)
    {
        &not_logged_in($q);
        return;
    }

    open PWD, "$pwd_file" or logdie "Cannot open $pwd_file: $!\n";
    my @pwd = <PWD>;
    close PWD;
    foreach my $pwd (@pwd)
    {
        if ((split(/:/, @pwd))[0] eq $user)
        {
            last if (split(/:/, @pwd))[2] eq "admin";

            print $q->header,
                  $q->start_html(-title   => 'Uptimetrics - Unknown',
                                 -vlink   => '#0000ff',
                                 -style   => $style_right),
                  "You are not an administrator!",
                  $q->end_html;

            return;
        }
    }

    (af_header($q, $user)  && ($frame_ok = 1)) if $frame eq "header";
    (af_task($q, $user) && ($frame_ok = 1)) if $frame eq "task";
    (af_detail($q, $user)  && ($frame_ok = 1)) if $frame eq "detail";

    if (! $frame_ok)
    {
        print $q->header,
              $q->start_html(-title   => 'Uptimetrics - Unknown',
                             -vlink   => '#0000ff',
                             -style   => $style_right),
              "Unknown frame name?",
              $q->end_html;
    }
}

##################################################################
##################################################################
##################################################################

sub do_aframes
{
    my $q=shift;
    my $af_header  = $q->url()."?aframe=header";
    my $af_task    = $q->url()."?aframe=task";
    my $af_detail  = $q->url()."?aframe=detail";

    print $q->header,
          "<html>\n",
          "<frameset rows='70,*' frameborder='0' marginheigt='0' marginwidth='0'>\n",
              "<frame src='$af_header' name='header'>\n",
              "<frameset cols='30%,*' frameborder=1>\n",
                  "<frame src='$af_task' name='task'>\n",
                  "<frame src='$af_detail' name='detail'>\n",
              "</frameset>\n",
          "</frameset>\n",
          "</html>";
}

##################################################################
##################################################################
##################################################################

sub f_header
{
    my ($q, $user) = @_;
    my $type = "user";

    open PWD, "$pwd_file" or logdie "Cannot open $pwd_file: $!\n";
    my @pwd = <PWD>;
    close PWD;
    foreach my $pwd (@pwd)
    {
        if ((split(/:/, $pwd))[0] eq $user)
        {
            $type = (split(/:/, $pwd))[2];
            last;
        }
    }

    my $script = '
       function open_admin()
       {
           window.open("' . $q->url() . '?aframes=1", "umadmin");
       }';

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics - Header',
                         -vlink   => '#0000ff',
                         -style   => $style_top,
                         -script  => $script),
          $q->table( { -width => '100%', -border => '0', -cellspacing => '0', -cellpadding => '0' },
            $q->Tr(
              $q->td( { -align => 'center', -width => '33%' }, $q->big($q->b('Uptimetrics'))),
              $q->td( { -align => 'center', -width => '33%' }, 
                      $q->a( { -href => 'http://www.sysman.nl', -target => "_top" } , 
                        $q->img( { -src => $q->url() . "?img=sysman.gif", -border => 0 } ))
                      ),
              $q->td( { -align => 'center', -width => '33%' }, 
                        $q->big($q->b($q->a( { -href => $q->url() . "?state=1", -target => "_top" }, 'Login'))),
                        ($type eq "admin") ? $q->br : "",
                        ($type eq "admin") ? $q->big($q->b($q->a( { -href   => "javascript:open_admin()" },
                                                                  'Admin' ))) : "")
            )
          ),
          $q->end_html;
}

##################################################################
##################################################################
##################################################################

sub f_left
{
    my ($q, $user) = @_;
    my $curr_srv = $q->param('service');

    open PWD, "$pwd_file" or logdie "Cannot open $pwd_file: $!\n";
    my @pwd = <PWD>;
    close PWD;
 
    chomp @pwd;
    my @allowed;
    foreach my $pwd (@pwd)
    {
        my @items = split /:/, $pwd;
        my $uid = $items[0];
        @allowed = split /,/, $items[3];
        last if $user eq $uid;
    }

    open SRVS, "$services_file" or logdie "Cannot open $services_file: $!\n";
    my @all_srvs= <SRVS>;
    close SRVS;

    chomp(@all_srvs);
    my (%srvs, @srvs);
    $srvs[0] = '0';
    $srvs{'0'} = "<choose service>";
    foreach my $srv (@all_srvs)
    {
        my ($srvid, $srvname) = split /:/, $srv;
        if (@allowed && ($allowed[0] eq "ALL" || grep(/^$srvid$/, @allowed)))
        {
            push @srvs, $srvid;
            $srvs{$srvid} = $srvname;
        }
    }

    my $script = '
       function show_overview(do_submit)
       {
           parent.frames["right"].document.forms[0].overview.value = 1
           parent.frames["right"].document.forms[0].srv.value =
                  document.forms[0].service.options[document.forms[0].service.options.selectedIndex].value
           parent.frames["right"].document.forms[0].submit()
           if (do_submit) { document.forms[0].submit() }
       }';

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics - left',
                         -vlink   => '#0000ff',
                         -style   => $style_left,
                         -script  => $script),
          $q->startform,
          $q->hidden(-name => 'frame',  -default => 'left'),
          $q->center($q->big($q->b("Service id"))),
          $q->center($q->popup_menu(-name     => 'service',
                                    -values   => \@srvs,
                                    -labels   => \%srvs,
                                    -onChange => 'show_overview(1)',
                                    -default  => $curr_srv));

    if ($curr_srv)
    {
        print $q->p,
              $q->big($q->a( { -href   => $q->url() . "?frame=right&weekmetrics=1&srv=$curr_srv",
                               -target => "right" }, "Show weekly metrics" )),
              $q->br,
              $q->big($q->a( { -href   => $q->url() . "?frame=right&monthmetrics=1&srv=$curr_srv",
                               -target => "right" }, "Show monthly metrics" )),
              $q->br,
              $q->big($q->a( { -href   => "javascript:show_overview(0)" } , "Show overview" )),
              $q->br,
              $q->big($q->a( { -href   => $q->url() . "?frame=right&schedule=1&srv=$curr_srv",
                               -target => "right" }, "Show schedule" ));
    }

    print $q->endform,
          $q->end_html;
}

##################################################################
##################################################################
##################################################################

sub show_schedule
{
    my ($q, $srv, $srvname) = @_;

    open SCHED, "$UMDIR/data/services/$srv/schedule"
         or logdie "Cannot open $UMDIR/data/services/$srv/schedule: $!\n";
    my @all_sched= <SCHED>;
    close SCHED;
    chomp(@all_sched);
    @all_sched = sort @all_sched;

    print $q->h1("Schedule for: " . $srvname);

    my $tr_sched = "";
    my $tr_adhoc = "";
    foreach my $sched (@all_sched)
    {
        my @parts = split /:/, $sched;

        $parts[2] =~ /(\d{4})(\d{2})(\d{2})/;
        my $start = ($parts[2] eq '-') ? '-' : "$1/$2/$3";
        $parts[3] =~ /(\d{4})(\d{2})(\d{2})/;
        my $end = ($parts[3] eq '-') ? '-' : "$1/$2/$3";

        my $days = "";
        my @days = split /,/, $parts[6];
        if (scalar(@days) == 7) { $days = 'All'; }
        else
        {
            foreach my $i (0 .. $#days) { $days[$i] = $wd[$days[$i]]; }
            $days = join(", ",  @days);
        }

        my $open = "";
        if ($parts[4] eq '-') { $open = '00:00'; }
        else { $open = sprintf("%02d:%02d", split(/\./, $parts[4])); }

        my $close = "";
        if ($parts[5] eq '-') { $close = '23:59'; }
        else { $close = sprintf("%02d:%02d", split(/\./, $parts[5])); }

        my $reason = "";
        $reason = $parts[7] if $parts[7];

        if ($parts[0] eq "s")
        {
             $tr_sched .=
                 $q->Tr(
                   $q->td( { -class => 'white', -align => 'center' }, $parts[1] eq 'u' ? 'open' : 'closed' ),
                   $q->td( { -class => 'white', -align => 'center' }, $start ),
                   $q->td( { -class => 'white', -align => 'center' }, $end ),
                   $q->td( { -class => 'white', -align => 'center' }, $days ),
                   $q->td( { -class => 'white', -align => 'center' }, $open ),
                   $q->td( { -class => 'white', -align => 'center' }, $close )
                );
        }
        else
        {
             $tr_adhoc .=
                 $q->Tr(
                   $q->td( { -class => 'white', -align => 'center' }, $parts[1] eq 'u' ? 'open' : 'closed' ),
                   $q->td( { -class => 'white', -align => 'center' }, "$start<br>$open - $close" ),
                   $q->td( { -class => 'white', -align => 'center' }, $reason )
                );
        }
    }
    print $q->h2("Weekly schedule:"),
          $q->table( { -width => '100%', -border => '0' },
            $q->Tr(
              $q->th( { -width => '16%' }, "Open/closed"),
              $q->th( { -width => '16%' }, "Start period"),
              $q->th( { -width => '16%' }, "End period"),
              $q->th( { -width => '16%' }, "days"),
              $q->th( { -width => '16%' }, "Start time"),
              $q->th( { -width => '16%' }, "End time")
            ),
            $tr_sched
          ),
          $q->p,
          $q->hr,
          $q->h2("Ad hoc open/closed times:"),
          $q->table( { -width => '100%', -border => '0' },
            $q->Tr(
              $q->th( { -width => '25%' }, "Open/closed"),
              $q->th( { -width => '25%' }, "Date<br>Start/End"),
              $q->th( { -width => '25%' }, "Reason")
            ),
            $tr_adhoc
          );
}

##################################################################
##################################################################
##################################################################

sub edit_reason
{
    my ($q, $srv, $srvname) = @_;
    my $start = $q->param('start');
    my $file = $q->param('file');
    my $period = $q->param('period');
    my $periodstart = $q->param('periodstart');
    my @reason = ();

    $start =~ /(\d\d\d\d)(\d\d)(\d\d)/;
    my $disp_start = "$1/$2/$3";

    if ( -f "$file")
    {
        open REASON, $file;
        @reason = <REASON>;
        close REASON;
    }

    my $url = $q->url() . "?frame=right&srv=$srv&${period}metrics=1&${period}start=$periodstart";

    if ($q->param('cancelled'))
    {
       print $q->b("Action cancelled"),
             $q->p,
             $q->a( { -href => $url }, "Continue");
       return;
    }

    if ($q->param('do_submit'))
    {
       mkdir("$UMDIR/data/services/$srv/reasons", 0755) if ! -d  "$UMDIR/data/services/$srv/reasons";
       open REASON, ">$file";
       print REASON $q->param('reasontext');
       close REASON;

       print $q->b("Reason updated"),
             $q->p,
             $q->a( { -href => $url }, "Continue");
       return;
    }

    print $q->hidden( { -name => 'start', -default => $start } ),
          $q->hidden( { -name => 'period', -default => $period } ),
          $q->hidden( { -name => 'periodstart', -default => $periodstart } ),
          $q->hidden( { -name => 'file', -default => $file } ),
          $q->hidden( { -name => 'cancelled', -default => '0' } ),
          $q->hidden( { -name => 'do_submit', -default => '0' } ),
          $q->hidden( { -name => 'reason', -default => '1' } ),
          $q->h1("Edit reason for downtime at $disp_start"),
          $q->textarea(-name => 'reasontext', -default => join("", @reason), -rows => 5, -columns => 50),
          $q->p,
          $q->submit( { -name    => 'Cancel',
                        -value   => 'Cancel',
                        -onClick => 'cancel()' } ),
          $q->submit( { -name    => 'Change',
                        -value   => 'Change',
                        -onClick => 'set_submit()' } );
}

##################################################################
##################################################################
##################################################################

sub show_weekmetrics
{
    my ($q, $srv, $srvname) = @_;

    if (not $q->param('weekstart'))
    {
        # Find oldest day for this service; then present all weeks
        my @files = <$UMDIR/data/services/$srv/daily/*>;
        if (not @files)
        {
            print $q->big("No data available yet"),
                  $q->endform,
                  $q->end_html;
            return 1;
        }
        @files = sort @files;
        my $oldest = shift @files;
        my @oldest = split(/\//, $oldest);
        $oldest = pop(@oldest);
        $oldest = to_unxdate($oldest);
        $oldest = int($oldest / (24*60*60)) * 24*60*60 + 24*60*60;
        my $wday = (localtime($oldest))[6];
        $oldest -= (24*60*60* ($wday - 1)) if $wday > 1;
        $oldest -= 24*60*60* 6 if $wday == 0;


        my $newest = time;
        $newest = int($newest / (24*60*60)) * 24*60*60 + 24*60*60;
        $wday = (localtime($newest))[6];
        $newest -= (24*60*60* ($wday - 1)) if $wday > 1;
        $newest -= (24*60*60* 6) if $wday == 0;

        my $week = $newest;
        my $tr = $q->Tr(
                   $q->th( { -width => '25%' }, "Start of week"),
                   $q->th( { -width => '25%' }, "Total time service open"),
                   $q->th( { -width => '25%' }, "Total unscheduled down time"),
                   $q->th( { -width => '25%' }, "% uptime")
                 );
        while ($week >= $oldest)
        {
            my ($d, $m, $y) = (localtime($week))[3 .. 5];
            my $wk = sprintf("%04d%02d%02d", $y+1900, $m+1, $d);
            my $fn = "$UMDIR/data/services/$srv/weekly/$wk";
            if ( -f $fn)
            {
                open WEEKLY, $fn or logdie "Cannot open file $fn: $!";
                chomp(my $stats = <WEEKLY>);
                close WEEKLY;
                my ($type, $open, $down) = split /:/, $stats;
                my $perc = ($open == 0) ? '100.000' : sprintf("%.03f", (($open - $down)/$open) * 100);
                $open = sprintf("%02d:%02d", int($open / 60), $open % 60);
                $down = sprintf("%02d:%02d", int($down / 60), $down % 60);

                $tr .= $q->Tr(
                         $q->td( { -align => "center" },
                                 $q->a( { -href   => $q->url() . "?frame=right&weekmetrics=1&srv=$srv&weekstart=$wk" },
                                         sprintf ("%04d/%02d/%02d", $y+1900, $m+1, $d) )),
                         $q->td( { -align => "center", -class => 'white' }, $open),
                         $q->td( { -align => "center", -class => 'white' }, $down),
                         $q->td( { -align => "center", -class => 'white' }, $perc)
                       );
            }
            $week -= 7*24*60*60;
        }

        print $q->h1("Weekly metrics for: $srvname"),
              $q->table( { -width => '100%' }, $tr);
    }
    else
    {
        # Show the week
        my $s_start = $q->param('weekstart');
        my $fn = "$UMDIR/data/services/$srv/weekly/$s_start";

        open WEEKLY, $fn or logdie "Cannot open file $fn: $!";
        chomp(my $stats = <WEEKLY>);
        my @downs = <WEEKLY>;
        close WEEKLY;
        chomp @downs;

        my ($type, $open, $down) = split /:/, $stats;
        my $perc = ($open == 0) ? '100.000' : sprintf("%.03f", (($open - $down)/$open) * 100);

        my $tr = "";
        foreach my $dn (@downs)
        {
            my ($type, $down, $len) = split /:/, $dn;
            my @reason = ();
            if ( -f "$UMDIR/data/services/$srv/reasons/$type-$down" )
            {
                open REASON, "$UMDIR/data/services/$srv/reasons/$type-$down";
                @reason = <REASON>;
                close REASON;
            }

            $down =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})/;
            my ($m_s, $h_s, $D_s, $M_s, $Y_s) = ($5, $4, $3, $2, $1);
            my $start = timelocal(0, $m_s, $h_s, $D_s, $M_s - 1, $Y_s - 1900);
            my $end = $start + $len*60;
            my ($m_e, $h_e, $D_e, $M_e, $Y_e) = (localtime($end))[1 .. 5];
            $Y_e += 1900; $M_e++;

            $tr = $q->Tr(
                    $q->td( { -class => 'white', -align => 'center' },
                            sprintf("%04d/%02d/%02d %02d:%02d<br>", $Y_s, $M_s, $D_s, $h_s, $m_s),
                            sprintf("%04d/%02d/%02d %02d:%02d", $Y_e, $M_e, $D_e, $h_e, $m_e)),
                    $q->td( { -class => 'white', -align => 'center' },
                            sprintf("%02d:%02d", int($len / 60), $len % 60)),
                    $q->td( { -class => 'white', -align => 'left' }, join("&nbsp;<br>", @reason) . "&nbsp"),
                    ($is_admin) ?
                        $q->td( { -class => 'white', -align => 'center' }, 
                                $q->a( { -href => $q->url() . "?frame=right&" .
                                                              "srv=$srv&" . 
                                                              "reason=1&" . 
                                                              "start=$down&" . 
                                                              "file=$UMDIR/data/services/$srv/reasons/$type-$down&" .
                                                              "period=week&" .
                                                              "periodstart=$s_start"},
                                       $q->img( { -src => $q->url() . "?img=note.gif", -border => 0 } ))) : ""
                  ) . $tr;
        }

        if (not @downs)
        {
            $tr = $q->Tr(
                    $q->td( { -class => 'white', -align => 'center' }, '-'),
                    $q->td( { -class => 'white', -align => 'center' }, '00:00'),
                    $q->td( { -class => 'white', -align => 'center' }, '-'),
                    ($is_admin) ? $q->td( { -class => 'white', -align => 'center' }, '-') : ""
                  ) . $tr;
        }

        $tr = $q->Tr(
                $q->th( { -width => '25%' }, "Start down<br>End down"),
                $q->th( { -width => '15%' }, "Down time"),
                $q->th( { -width => '55%' }, "reason"),
                ($is_admin) ? $q->th( { -width => '5%' }, "&nbsp") : ""
              ) . $tr;

        $s_start =~ /(\d{4})(\d{2})(\d{2})/;
        print $q->h1("Detailed metrics for: $srvname"),
              $q->center($q->big($q->b("Uptime week starting $1/$2/$3: $perc%"))),
              $q->center($q->img( { -src => $q->url() . "?draw=1&srv=$srv&week=$s_start", -border => '0' } )),
              $q->hr,
              $q->center($q->table( { -width => '500' }, $tr));
    }
}

##################################################################
##################################################################
##################################################################

sub show_monthmetrics
{
    my ($q, $srv, $srvname) = @_;

    if (not $q->param('monthstart'))
    {
        # Find oldest month for this service; then present all months
        my @files = <$UMDIR/data/services/$srv/daily/*>;
        if (not @files)
        {
            print $q->big("No data available yet"),
                  $q->endform,
                  $q->end_html;
            return 1;
        }
        @files = sort @files;
        my $oldest = shift @files;
        my @oldest = split(/\//, $oldest);
        $oldest = pop(@oldest);
        $oldest =~ /(\d{4})(\d{2})(\d{2})/;
        my $oldest_m = $2 - 1;
        my $oldest_y = $1 - 1900;

        my $tr = $q->Tr(
                   $q->th( { -width => '25%' }, "Month"),
                   $q->th( { -width => '25%' }, "Total time service open"),
                   $q->th( { -width => '25%' }, "Total unscheduled down time"),
                   $q->th( { -width => '25%' }, "% uptime")
                 );

        my ($month, $year) = (localtime(time))[4, 5];
        while ($year > $oldest_y || ($year == $oldest_y && $month >= $oldest_m))
        {
            my $mn = sprintf("%04d%02d%02d", $year+1900, $month+1, 1);
            my $fn = "$UMDIR/data/services/$srv/monthly/$mn";
            if ( -f $fn)
            {
                open MONTHLY, $fn or logdie "Cannot open file $fn: $!";
                chomp(my $stats = <MONTHLY>);
                close MONTHLY;
                my ($type, $open, $down) = split /:/, $stats;
                my $perc = ($open == 0) ? '100.000' : sprintf("%.03f", (($open - $down)/$open) * 100);
                $open = sprintf("%02d:%02d", int($open / 60), $open % 60);
                $down = sprintf("%02d:%02d", int($down / 60), $down % 60);

                $tr .= $q->Tr(
                         $q->td( { -align => "center" },
                                  $q->a( { -href => $q->url() . 
                                                    "?frame=right&monthmetrics=1&srv=$srv&monthstart=$mn" },
                                         sprintf ("%04d/%02d", $year+1900, $month+1) )),
                         $q->td( { -align => "center", -class => 'white' }, $open),
                         $q->td( { -align => "center", -class => 'white' }, $down),
                         $q->td( { -align => "center", -class => 'white' }, $perc)
                       );
            }
            $month--;
            if ($month < 0)
            {
                $month = 12;
                $year--;
            }
        }

        print $q->h1("Monthly metrics for: $srvname"),
              $q->table( { -width => '100%' }, $tr);
    }
    else
    {
        # Show the month
        my $s_start = $q->param('monthstart');
        my $fn = "$UMDIR/data/services/$srv/monthly/$s_start";

        open MONTHLY, $fn or logdie "Cannot open file $fn: $!";
        chomp(my $stats = <MONTHLY>);
        my @downs = <MONTHLY>;
        close MONTHLY;
        chomp @downs;

        my ($type, $open, $down) = split /:/, $stats;
        my $perc = ($open == 0) ? '100.000' : sprintf("%.03f", (($open - $down)/$open) * 100);

        my $tr = "";
        foreach my $dn (@downs)
        {
            my ($type, $down, $len) = split /:/, $dn;
            my @reason = ();
            if ( -f "$UMDIR/data/services/$srv/reasons/$type-$down" )
            {
                open REASON, "$UMDIR/data/services/$srv/reasons/$type-$down";
                @reason = <REASON>;
                close REASON;
            }

            $down =~ /(\d{4})(\d{2})(\d{2})(\d{2})(\d{2})/;
            my ($m_s, $h_s, $D_s, $M_s, $Y_s) = ($5, $4, $3, $2, $1);
            my $start = timelocal(0, $m_s, $h_s, $D_s, $M_s - 1, $Y_s - 1900);
            my $end = $start + $len*60;
            my ($m_e, $h_e, $D_e, $M_e, $Y_e) = (localtime($end))[1 .. 5];
            $Y_e += 1900; $M_e++;

            $tr = $q->Tr(
                    $q->td( { -class => 'white', -align => 'center' },
                            sprintf("%04d/%02d/%02d %02d:%02d<br>", $Y_s, $M_s, $D_s, $h_s, $m_s),
                            sprintf("%04d/%02d/%02d %02d:%02d", $Y_e, $M_e, $D_e, $h_e, $m_e)),
                    $q->td( { -class => 'white', -align => 'center' },
                            sprintf("%02d:%02d", int($len / 60), $len % 60)),
                    $q->td( { -class => 'white', -align => 'left' }, join("&nbsp;<br>", @reason) . "&nbsp"),
                    ($is_admin) ?
                        $q->td( { -class => 'white', -align => 'center' }, 
                                $q->a( { -href => $q->url() . "?frame=right&" .
                                                              "srv=$srv&" . 
                                                              "reason=1&" . 
                                                              "start=$down&" . 
                                                              "file=$UMDIR/data/services/$srv/reasons/$type-$down&" .
                                                              "period=month&" .
                                                              "periodstart=$s_start"},
                                       $q->img( { -src => $q->url() . "?img=note.gif", -border => 0 } ))) : ""
                  ) . $tr;
        }

        if (not @downs)
        {
            $tr = $q->Tr(
                    $q->td( { -class => 'white', -align => 'center' }, '-'),
                    $q->td( { -class => 'white', -align => 'center' }, '00:00'),
                    $q->td( { -class => 'white', -align => 'center' }, '-'),
                    ($is_admin) ? $q->td( { -class => 'white', -align => 'center' }, '-') : ""
                  ) . $tr;
        }

        $tr = $q->Tr(
                $q->th( { -width => '25%' }, "Start down<br>End down"),
                $q->th( { -width => '15%' }, "Down time"),
                $q->th( { -width => '55%' }, "reason"),
                ($is_admin) ? $q->th( { -width => '5%' }, "&nbsp") : ""
              ) . $tr;

        $s_start =~ /(\d{4})(\d{2})(\d{2})/;
        print $q->h1("Detailed metrics for: $srvname"),
              $q->center($q->big($q->b("Uptime month $1/$2: $perc%"))),
              $q->center($q->img( { -src => $q->url() . "?draw=1&srv=$srv&month=$s_start", -border => '0' } )),
              $q->hr,
              $q->center($q->table( { -width => '500' }, $tr));
    }
}

##################################################################
##################################################################
##################################################################

sub show_overview
{
    my ($q, $srv, $srvname) = @_;
    my ($d, $m, $y) = (localtime(time - 6*24*60*60))[3 .. 5];
    $m++; $y+=1900;

    print $q->center($q->h1("Metrics for: $srvname"));

    #
    #### Do the week
    #
    my $s_start = sprintf("%04d%02d%02d", $y, $m, $d);

    my $day = timelocal(0, 0, 0, $d, $m-1, $y-1900);
    my ($tot_open, $tot_down) = (0, 0);
    foreach my $i (0 .. 6)
    {
        my ($d, $m, $y) = (localtime($day))[3 .. 5];
        $m++; $y+=1900;
        my $fn = sprintf("$UMDIR/data/services/$srv/daily/%04d%02d%02d", $y, $m, $d);
        if (-f $fn)
        {
            open DAILY, $fn or logdie "Cannot open file $fn: $!";
            <DAILY>;  # loose array
            chomp(my $stats = <DAILY>);
            close DAILY;

            my ($type, $open, $down) = split /:/, $stats;
            $tot_open += $open;
            $tot_down += $down;
        }
        $day += 24*60*60;
    }
    my $perc = ($tot_open == 0) ? '100.000' : sprintf("%.03f", (($tot_open - $tot_down)/$tot_open) * 100);
    print $q->center($q->big("Uptime last 7 days: $perc%")),
          $q->center($q->img( { -src => $q->url() . "?draw=1&srv=$srv&week=$s_start", -border => '0' } )),
          $q->br,
          $q->hr,
          $q->br;

    #
    #### Do the month
    #
    ($d, $m, $y) = (localtime(time - 29*24*60*60))[3 .. 5];
    $m++; $y+=1900;
    $s_start = sprintf("%04d%02d%02d", $y, $m, $d);
    $day = timelocal(0, 0, 0, $d, $m-1, $y-1900);
    ($tot_open, $tot_down) = (0, 0);
    foreach my $i (0 .. 30)
    {
        my ($d, $m, $y) = (localtime($day))[3 .. 5];
        $m++; $y+=1900;
        my $fn = sprintf("$UMDIR/data/services/$srv/daily/%04d%02d%02d", $y, $m, $d);
        if (-f $fn)
        {
            open DAILY, $fn or logdie "Cannot open file $fn: $!";
            <DAILY>;  # loose array
            chomp(my $stats = <DAILY>);
            close DAILY;

            my ($type, $open, $down) = split /:/, $stats;
            $tot_open += $open;
            $tot_down += $down;
        }
        $day += 24*60*60;
    }
    $perc = ($tot_open == 0) ? '100.000' : sprintf("%.03f", (($tot_open - $tot_down)/$tot_open) * 100);
    print $q->center($q->big("Uptime last 31 days: $perc%")),
          $q->center($q->img( { -src => $q->url() . "?draw=1&srv=$srv&month=$s_start", -border => '0' } )),
          $q->br,
          $q->hr,
          $q->br;

    #
    #### Do the year
    #
    ($d, $m, $y) = (localtime(time - 364*24*60*60))[3 .. 5];
    $m++; $y+=1900;
    $s_start = sprintf("%04d%02d%02d", $y, $m, $d);
    $day = timelocal(0, 0, 0, $d, $m-1, $y-1900);
    ($tot_open, $tot_down) = (0, 0);
    foreach my $i (0 .. 364)
    {
        my ($d, $m, $y) = (localtime($day))[3 .. 5];
        $m++; $y+=1900;
        my $fn = sprintf("$UMDIR/data/services/$srv/daily/%04d%02d%02d", $y, $m, $d);
        if (-f $fn)
        {
            open DAILY, $fn or logdie "Cannot open file $fn: $!";
            <DAILY>;  # loose array
            chomp(my $stats = <DAILY>);
            close DAILY;

            my ($type, $open, $down) = split /:/, $stats;
            $tot_open += $open;
            $tot_down += $down;
        }
        $day += 24*60*60;
    }
    $perc = ($tot_open == 0) ? '100.000' : sprintf("%.03f", (($tot_open - $tot_down)/$tot_open) * 100);
    print $q->center($q->big("Uptime last 365 days: $perc%")),
          $q->center($q->img( { -src => $q->url() . "?draw=1&srv=$srv&year=$s_start", -border => '0' } ));
}

##################################################################
##################################################################
##################################################################

sub f_right
{
    my ($q, $user) = @_;

    my $srv = $q->param('srv');
    if ($srv)
    {
        return 1 if not verify_access($q, $srv);
    }

    open MONS, "$services_file" or logdie "Cannot open $services_file: $!\n";
    my @all_srvs= <MONS>;
    close MONS;
    chomp(@all_srvs);
    my (%srvs, @srvs);
    foreach my $srv (@all_srvs)
    {
        my ($srvid, $srvname) = split /:/, $srv;
        push @srvs, $srvid;
        $srvs{$srvid} =  $srvname;
    }

    my $script = '
       function cancel()
       {
           document.forms[0].cancelled.value = 1
           return 1
       }
       function set_submit()
       {
           document.forms[0].do_submit.value = 1
           return 1
       }';

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics - right',
                         -vlink   => '#0000ff',
                         -style   => $style_right,
                         -script  => $script),
          $q->startform,
          $q->hidden( { -name => 'frame', -default => 'right' } ),
          $q->hidden( { -name => 'overview', -default => '0' } ),
          $q->hidden( { -name => 'srv', -default => '0' } );

    show_overview($q, $srv, $srvs{$srv}) if $q->param('overview') && $srv;
    show_schedule($q, $srv, $srvs{$srv}) if $q->param('schedule') && $srv;
    edit_reason($q, $srv, $srvs{$srv}) if $q->param('reason') && $srv;
    show_weekmetrics($q, $srv, $srvs{$srv}) if $q->param('weekmetrics') && $srv;
    show_monthmetrics($q, $srv, $srvs{$srv}) if $q->param('monthmetrics') && $srv;

    print $q->endform,
          $q->end_html;
}

##################################################################
##################################################################
##################################################################

sub do_frame
{
    my $q = shift;
    my $cookie = $q->cookie(-name => 'Uptimetrics');
    $cookie = "<unknown>" if not $cookie;
    my $user = $sessions{$cookie};
    my $frame_ok = 0;
    my $frame = $q->param('frame');

    if (! $user)
    {
        &not_logged_in($q);
        return;
    }

    (f_header($q, $user)  && ($frame_ok = 1)) if $frame eq "header";
    (f_left($q, $user) && ($frame_ok = 1)) if $frame eq "left";
    (f_right($q, $user)  && ($frame_ok = 1)) if $frame eq "right";

    if (! $frame_ok)
    {
        print $q->header,
              $q->start_html(-title   => 'Uptimetrics - Unknown',
                             -vlink   => '#0000ff',
                             -style   => $style_right),
              "Unknown frame name?",
              $q->end_html;
    }
}

##################################################################
##################################################################
##################################################################

sub frames
{
    my $q=shift;
    my $f_header  = $q->url()."?frame=header";
    my $f_left    = $q->url()."?frame=left";
    my $f_right   = $q->url()."?frame=right";

    print $q->header,
          "<html>\n",
          "<frameset rows='70,*' frameborder='0' marginheigt='0' marginwidth='0'>\n",
              "<frame src='$f_header' name='header'>\n",
              "<frameset cols='30%,*' frameborder=1>\n",
                  "<frame src='$f_left' name='left'>\n",
                  "<frame src='$f_right' name='right'>\n",
              "</frameset>\n",
          "</frameset>\n",
          "</html>";
}

##################################################################
##################################################################
##################################################################

sub loginerror
{
    my $q=shift;

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics Loginfailure',
                         -vlink   => '#0000ff',
                         -style   => $style_right,
                         -target  => "_top"),
          $q->h1("Uptimetrics"),
          $q->b("Login failed, try again"),
          $q->p,
          $q->a({href => $q->url() . "?state=1"} , "Login"),
          $q->end_html;
}

##################################################################
##################################################################
##################################################################

sub not_logged_in
{
    my $q=shift;

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics Not Logged In',
                         -vlink   => '#0000ff',
                         -style   => $style_right,
                         -target  => "_top"),
          $q->h1("Uptimetrics"),
          $q->b("You are not logged in."),
          $q->p,
          $q->a({href => $q->url() . "?state=1"} , "Login"),
          $q->p,
          $q->a({href => $q->url()} , "Anonymous Login"), " (No password required)",
          $q->end_html;
}

##################################################################
##################################################################
##################################################################

sub login
{
    my $q=shift;
    my $userid = $q->param("userid");
    my $password = $q->param("password");
    my $equal = 1;
    if ($q->param('newpwd'))
    {
        if ($q->param('newpassword1') && ($q->param('newpassword1') eq $q->param('newpassword2')))
        {
            my $pwd = crypt($q->param('newpassword1'),
                            join('', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
            my ($type, $services);

            open PWD, "$pwd_file" or logdie "Cannot open $pwd_file: $!\n"; my @all_pwd = <PWD>; close PWD;
            chomp @all_pwd;
            open PWDN, ">>$pwd_file.new" or logdie "Cannot open $pwd_file.new: $!\n";
            foreach my $pw (@all_pwd)
            {
                print PWDN "$pw\n" if (split(/:/, $pw))[0] ne $userid;
                ($type, $services) = (split(/:/, $pw))[2,3] if (split(/:/, $pw))[0] eq $userid;
            }
            print PWDN "$userid:$pwd:$type:$services\n";
            close PWDN;
            rename("$pwd_file.new", "$pwd_file") or logdie "Cannot rename  .users: $!\n";

            my $cookie = $q->cookie(-name => "Uptimetrics",
                                    -value => $q->param('umID'),
                                    -expires => "+10h");

            $sessions{$q->param('umID')} = $userid;
            print $q->redirect(-location => $q->url()."?state=2", -cookie => $cookie)
        }
        else
        {
            $equal = 0;
        }
    }
 
    if ($q->param('checklogin'))
    {
        open(PWD, $pwd_file) or logdie "Cannot open file $pwd_file: $!\n";
        my @pwd = <PWD>;
        close PWD;
        foreach my $pwdline (@pwd)
        {
            my ($uid, $pwd) = (split(/:/, $pwdline))[0, 1];
            if ($uid eq $userid && crypt($password, $pwd) eq $pwd)
            {
                my $cookie = $q->cookie(-name => "Uptimetrics",
                                        -value => $q->param('umID'),
                                        -expires => "+10h");

                $sessions{$q->param('umID')} = $userid;
                if ($q->param('changepwd'))
                {
                    goto REPRINT;
                }
                else
                {
                    print $q->redirect(-location => $q->url()."?state=2", -cookie => $cookie);
                }
            }
        }
        print $q->redirect(-location => $q->url()."?state=3");
    }

    REPRINT:
    my $umID=int(rand(10000000));

    my $script = '
       function do_submit()
       {
           if (document.forms[0].changepwd)
           {
               if (document.forms[0].newpassword1 &&
                   document.forms[0].newpassword1.value == "")
               {
                   alert("Empty password is not allowed")
                   return
               }
               if (document.forms[0].newpassword1 &&
                   document.forms[0].newpassword1.value != document.forms[0].newpassword2.value)
               {
                   alert("Passwords are not equal")
                   return
               }
           }
           document.forms[0].submit()
       }';

    print $q->header,
          $q->start_html(-title   => 'Uptimetrics Login',
                         -vlink   => '#0000ff',
                         -style   => $style_right,
                         -script  =>  $script),
          $q->h1("Uptimetrics login"),
          $q->startform;

    if ($q->param('changepwd'))
    {
        print($q->p($q->b('New password is empty, or passwords are not equal'))) if not $equal;
        print $q->h1("Change password for $userid"),
              $q->table(
                $q->Tr( $q->td("New password"),
                          $q->td($q->password_field( -name=>'newpassword1',
                                                         -size      => 15,
                                                         -maxlength => 15))),
                $q->Tr( $q->td("Retype new password"),
                          $q->td($q->password_field( -name=>'newpassword2',
                                                         -size      => 15,
                                                         -maxlength => 15))),
                $q->Tr( $q->td(),
                          $q->td($q->a( { -href => "javascript:self.do_submit()" }, "Change")))),
              $q->hidden(-name => 'changepwd', -default => '1'),
              $q->hidden(-name => 'newpwd', -default => '1'),
              $q->hidden(-name => 'userid', -default => "$userid"),
              $q->p;
    }
    else
    {
        print $q->table(
                $q->Tr( $q->td("Username"),
                          $q->td($q->textfield(-name=>'userid',
                                               -size      => 15,
                                               -maxlength => 15))),
                $q->Tr( $q->td("Password"),
                          $q->td($q->password_field( -name=>'password',
                                                     -size      => 15,
                                                     -maxlength => 15))),
                $q->Tr( $q->td("Change password?"),
                          $q->td($q->checkbox(-name    => 'changepwd',
                                              -checked => '',
                                              -value   => 'change',
                                              -label   => 'Change'))),
                $q->Tr( $q->td(),
                          $q->td($q->a( { -href => "javascript:self.do_submit()" }, "Login")))),
              $q->hidden(-name => 'checklogin', -default => '1'),
              $q->p;
    }

    print $q->img( { -src => $q->url() . "?img=sysman.gif" } ),
          $q->hidden(-name => 'umID',       -default =>  $umID),
          $q->hidden(-name => 'state',      -default => '1'),
          $q->endform,
          $q->end_html;
}

##################################################################
##################################################################
##################################################################

sub do_cgi
{
    CGI::_reset_globals;

    my $q = new CGI;
logmsg("In do_cgi\n");

    if ($q->param('aframes') )         { do_aframes($q); return }
    if ($q->param('aframe') )          { do_aframe($q); return }
    if ($q->param('frame') )           { do_frame($q); return }
    if ($q->param('draw') )            { draw_img($q); return }
    if ($q->param('img') )             { sendimg($q); return }
    if ($q->param('state'))
    {
        if ($q->param('state') eq "1" )    { login($q); return }
        if ($q->param('state') eq "2" )    { frames($q); return }
        if ($q->param('state') eq "3" )    { loginerror($q); return }
    }

logmsg("Niks gedaan\n");

    open(PWD, $pwd_file) or logdie "Cannot open file $pwd_file: $!\n";
    my @pwd = <PWD>;
    close PWD;
    foreach my $pwd (@pwd)
    {
        my $userid = (split(/:/, $pwd))[0];
        if ($userid eq "anonymous")
        {
            my $umID=int(rand(10000000));
            $sessions{$umID} = $userid;
            my $cookie = $q->cookie(-name => "Uptimetrics",
                                    -value => $umID,
                                    -expires => "+10h");

            print $q->redirect(-location => $q->url()."?state=2",
                                 -cookie => $cookie);
            return;
        }
    }
    print $q->redirect(-location => $q->url()."?state=1");
}

##################################################################
##################################################################
##################################################################

open (STDERR, ">>$UMDIR/logs/umfe.log");

STDOUT->autoflush(1);
STDERR->autoflush(1);

logmsg "umfe started\n";
getconfig;

while (1)
{
    my $ln = <STDIN>;
    next if $ln !~ /^helo/;

    # If reading the data takes more than 30 seconds, timeout
    eval
    {
        local $SIG{ALRM} = sub { die "alarm\n" };
        alarm 30;

        do
        {
            # Create some environment variables as set by the web server
            chomp($ln = <STDIN>);
            if ($ln =~ /^CTENV /)
            {
                my $e = substr($ln, 6);
                $e =~ /(.*?)=(.*)/;
                my ($var, $val) = ($1, $2);
                $ENV{$var} = $val;
            }
        } while ($ln !~ /^CTENV_END/);

        do_cgi();
        print "__END__";

        alarm 0;
    };

    if ($@ eq "alarm\n")
    {
        logdie "Timeout while serving data - restart\n";
    }
    elsif ($@)
    {
        logmsg "Unknown error: $@";
    }
}
