#!/usr/pkg/bin/perl
use strict;
use Net::DNS;	# net/p5-Net-DNS
#
#  Requires net/httping installed
#  Now (specified_directory) is fixed to /usr/pkgsrc
#
# 1. read (specified_directory)/mk/fetch/sites.mk (into %SITE)
# 2. for each site found above (%SITE)
#    a. Check DNS
#    b. httping 
#   and collect fail site name in %FAIL
# 3.  in  (specified_directory)/mk/fetch/sites.mk
#   if site is in %FAIL, it would place # in leftmost columns
#   if the particular line.

my $DEBUG = 0;
my $NoHost = 0;
my $DEBUG_COUNT = 999;

sub CheckSingleHttPing($);
sub Main();
sub ReadmkFetchSitesMk($);
sub Usage($);

## --------------- S U B R O U T I N E S --------------
sub ReadmkFetchSitesMk($) {
    my($pkgsrc) = shift;
    my(%SITES);
    open(FILE, $pkgsrc.'/mk/fetch/sites.mk') || print STDERR "Problem reading sites.mk:$!\n";
    while(<FILE>) {
	if ( m|\s*http://([^/]+)/| ||
    	    m|\s*https://([^/]+)/| ||
    	      m|\s*ftp://([^/]+)/| ||
	    0 ) {
	    my ($site ) = $1;
	    if ( $SITES{$site} eq '') {	$SITES{$site}++}; # not registered yet, new. register it.
	    if ($DEBUG_COUNT-- < 0 ) { last;}
	}
    }
    close(FILE);
    return %SITES;
}
sub CheckSingleHttPing($){
    my ($site) = shift;
    my ($fail);
#    if ( ! [ -x "/usr/pkg/bin/httping" ] ) { die "Please install net/httping\n";}
    
    open(HTTPING, "/usr/pkg/bin/httping -c 3 $site 2>&1|" );
    while(<HTTPING>) {
	if (/could not connect/ ) {
	    $fail = '(no_connection';
	}
                # 3 connects, 3 ok, 0.00% failed, time 1644ms
 	if (/[0-9]+ connects, [0-9]+ ok, ([0-9.]+)% failed, time (.*)ms/ ) {
	    $fail = $1;
	}
    }
    close(HTTPING);
    return $fail;
}

# sub CheckSingle($) {
#     my($site) = shift;
#     my($fail);
#     open(PING, "/sbin/ping -c 3 $site|" );
#     while(<PING>) {
# 	if (/3 packets transmitted, .* ([0-9.]+)% packet loss/ ) {
# 	    $fail = $1;
# 	}
#     }
#     close(PING);
#     return $fail;
# }

sub Usage($) {

}
sub CheckDNS($) {
    my ($hostname) = shift;
    print STDERR sprintf("%4d ", __LINE__) , ' hostname -> ', $hostname,' ', $_  if $DEBUG;
    my $res   = Net::DNS::Resolver->new;
    my $query = $res->search($hostname);
    if ( ! $query ) {
	print STDERR __LINE__, ' DNS query failed to ', "$hostname\n" if $DEBUG;
	$NoHost++; return 0;
    }
    return 1;
}
sub EditFetchSitesMk($@) {
    my ($pkgsrc) = shift;
    my (@FAIL) = @_;
    
    my ($DIR)  = $pkgsrc.'/mk/fetch/';
    my ($SITES_MK) = 'sites.mk';
    my ($NEW)      = 'sites.mk.new';

    chdir $DIR;
    if ( ! -f $SITES_MK) {
	print STDERR "Problem looking for the file $SITES_MK $! \n";
    }
    open(NEW,  "> $NEW" )      || print STDERR "Problem opening file: $NEW: $! \n";
    open(SITES_MK, $SITES_MK ) || print STDERR "Problem opening file: $SITES_MK: $! \n";
    while(<SITES_MK>) {
	foreach my $site (@FAIL) {
#	    print STDERR $site,"\n";
	    if (grep /$site/, $_) { $_ =~ s|^|# |; }
	}
	print NEW $_;
    }
    close(SITES_MK);
    close(NEW);
    rename $NEW, $SITES_MK;
    
}

## ------------ M A I N ------------
sub Main(){
    my (%FAIL);
    my (%SITES) =  ReadmkFetchSitesMk('/usr/pkgsrc');
    my (@SITES) = keys %SITES;
    print STDERR sprintf("%4d   ", __LINE__,), $#SITES + 1, " sites found.\n";
    my ($Total) = 0;
    my ($Bad)   = 0;
    foreach my $site (sort keys %SITES) {
	$site =~ s,https://,,;
    	$site =~ s,http://,,;
	$site =~ s,ftp://,,;
	$site =~ s,/$,,;
	if ( CheckDNS($site) == 0 ) {
	    print STDERR ' (DNS): ', $site, "\n";
	    $FAIL{$site}++; next
	} else {
	    print STDERR '.';	# OK, then next test
	}
	my $fail;
	if ( ($fail = CheckSingleHttPing($site)) ne '0.00') {
	    $FAIL{$site}++;
	    printf STDERR
	    ("%4d  Fail percentage to httping $site is %s. \n", __LINE__, $fail);
	}
    }
    print STDERR "-----------------------\n";
    print join ("\n", sort keys %FAIL);
    print STDERR "-----------------------\n" ;   
    EditFetchSitesMk('/usr/pkgsrc', sort keys %FAIL);
}
## ------------ end of M A I N ------------

Main();
__END__

Local Variables:
mode: outline-minor
outline-regexp: "sub\\|\#\#\\|Local Variables:"
End: