Annotation of loncom/debugging_tools/get_version.pl, revision 1.3

1.1       albertel    1: open(HOST,"<$ARGV[0]");
1.3     ! albertel    2: 
        !             3: if (!-e 'secure_args') {
        !             4:     die("Unable to find security arguments for grabbing lon-status");
        !             5: }
        !             6: 
        !             7: my $secure_args = `cat secure_args`;
        !             8: $secure_args =~ s/^\s*//x;
        !             9: $secure_args =~ s/\s*$//x;
1.1       albertel   10: my $i++;
                     11: my %vers;
1.3     ! albertel   12: my %distvers;
        !            13: my %arch;
1.1       albertel   14: my %done;
1.3     ! albertel   15: my %combo1;
        !            16: my %combo2;
1.1       albertel   17: while(my $line=<HOST>) {
                     18:     if ($line=~/^\#/) { next; }
                     19:     my $host=(split(':',$line))[3];
                     20:     chomp($host);
                     21:     if (!$host || exists($done{$host})) { next; }
                     22:     $done{$host}=1;
1.3     ! albertel   23: 
        !            24: 
        !            25:     my $roles=`curl --max-time 15 --connect-timeout 5 -s http://$host/adm/login  `;
        !            26:     if ($roles eq '') {
        !            27:         $roles=`curl --insecure --max-time 15 --connect-timeout 5 -s https://$host/adm/login `;
        !            28:     }
        !            29: 
        !            30: #-- lon-capa version
1.1       albertel   31:     print($host." -> ");
1.2       albertel   32:     my $ver=`curl --max-time 15 --connect-timeout 5 -s http://$host/adm/login | grep -- -200 | tr ">" "\n" | tail -1 `;
1.1       albertel   33:     $ver=~s/&nbsp;//g;
                     34:     $ver=~s/ //g;
1.3     ! albertel   35:     if ($ver eq "") {
        !            36: 	print(" https -> ");
        !            37:         $ver=`curl --insecure --max-time 15 --connect-timeout 5 -s https://$host/adm/login | grep -- -200 | tr ">" "\n" | tail -1 `;
        !            38:     }
        !            39:     $ver=~s/&nbsp;//g;
        !            40:     $ver=~s/ //g;
        !            41:     if ($ver eq "") {
        !            42: 	if ($roles eq '') { $ver="dead\n"; } else { $ver = "old\n" }
        !            43:     }
1.1       albertel   44:     print($ver);
                     45:     $ver=~s/\s//g;
                     46:     push(@{$vers{$ver}},$host);
1.3     ! albertel   47: 
        !            48:     print(' 'x(length($host)).' -> ');
        !            49:     my $lonstatus=`curl $secure_args --max-time 15 --connect-timeout 5 -s http://$host/lon-status/ `;
        !            50:     if ($lonstatus !~ /LON Status Report/) {
        !            51: 	print(" https -> ");
        !            52:         $lonstatus=`curl --insecure $secure_args --max-time 15 --connect-timeout 5 -s https://$host/lon-status/  `;
        !            53:     }
        !            54:     if ($lonstatus =~ /LON Status Report/) {
        !            55: 	print(" lon-status \n");
        !            56:     }
        !            57: 
        !            58: #-- OS 
        !            59:     my $dist = $lonstatus;
        !            60:     print(' 'x(length($host)).' -> ');
        !            61:     my $re = '.*distprobe.*?<pre>(.*?)</pre>.*';
        !            62: #    my $re = '.*?<h1>.*?</h1>.*?<h2>(.*?)</h2>.*';
        !            63:     if ($dist =~ m{$re}sx) {
        !            64: 	$dist=~s{$re}{$1}sx;
        !            65: 	print($dist);
        !            66:     } else {
        !            67: 	undef($dist);
        !            68:     }
        !            69: 
        !            70:     print("\n");
        !            71:     push(@{$distvers{$dist}},$host);
        !            72: 
        !            73: #-- arch
        !            74:     my $arch = $lonstatus;
        !            75:     print(' 'x(length($host)).' -> ');
        !            76:     my $re = '.*?Detected\s+64bit\s+platform\s*\((\d*)\).*';
        !            77:     if ($arch =~ m{$re}sx) {
        !            78: 	$arch=~s{$re}{$1}sx;
        !            79: 	print($arch);
        !            80:     } else {
        !            81: 	undef($arch);
        !            82:     }
        !            83:     print("\n");
        !            84:     push(@{$arch{$arch}},$host);
        !            85: 
        !            86:     $combo1{"$ver,$dist,$arch"}++;#.=$host.', ';
        !            87:     $combo2{"$dist,$arch"}++;#.=$host.', ';
        !            88: 
1.1       albertel   89: #    if ($i++==14) { last; }
                     90: }
1.3     ! albertel   91: print("LON-CAPA Versions\n");
1.1       albertel   92: foreach my $key (sort(keys(%vers))) {
1.3     ! albertel   93:     print($key." -> ".scalar(@{$vers{$key}})." machines\n");
        !            94:     print("     ".join("\n     ",sort(@{$vers{$key}}))."\n");
        !            95: }
        !            96: print("OS Versions\n");
        !            97: foreach my $key (sort(keys(%distvers))) {
        !            98:     print($key." -> ".scalar(@{$distvers{$key}})." machines\n");
        !            99:     print("     ".join("\n     ",sort(@{$distvers{$key}}))."\n");
        !           100: }
        !           101: print("64bit?\n");
        !           102: foreach my $key (sort(keys(%arch))) {
        !           103:     print($key." -> ".scalar(@{$arch{$key}})." machines\n");
        !           104:     print("     ".join("\n     ",sort(@{$arch{$key}}))."\n");
        !           105: }
        !           106: print("Combo 1?\n");
        !           107: foreach my $key (sort(keys(%combo1))) {
        !           108:     print($key." -> ".$combo1{$key}." machines\n");
        !           109: }
        !           110: print("Combo 2?\n");
        !           111: foreach my $key (sort(keys(%combo2))) {
        !           112:     print($key." -> ".$combo2{$key}." machines\n");
1.1       albertel  113: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>