1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
#!/usr/bin/perl -w
open(FD,">index.html") or die;
print FD "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
<html><head>
<meta http-equiv=\"content-type\" content=\"text/html; charset=iso-8859-2\">
<style type=\"text/css\">
body {
font-size: 12pt;
font-family: Courier, Courier-new}
a {
font-weight: bold}
h1, h2, h3, h4 {
font-family: Tahoma, Helvetica, Arial, sans-serif;
color: #f8f8f8};
h2 {
margin-top: 20;
margin-bottom: 5;
margin-left:10 }
table.ctests {
border: black 2px solid;
padding: 5px;
background: #606060}
th {
padding-left: 5px;
padding-right: 5px}
td {
padding-left: 5px;
padding-right: 5px}
</style><title>OK1ZIA - Provozak cervenec 2005</title>
</head>
<body text=\"#ffffff\" bgcolor=\"#3f4e66\" link=\"#ddad6a\" vlink=\"#cd9d5a\" alink=\"#edbd7a\"><center>
<center><h1>Logs</h1></center>
<br><br>
<table class=\"ctests\">
<tr>
<th bgcolor=\"#e4b97c\"><font color=\"#800000\">DATE </font></th>
<th bgcolor=\"#e4b97c\"><font color=\"#800000\">CALL </font></th>
<th bgcolor=\"#e4b97c\"><font color=\"#800000\">CTEST </font></th>
</tr>\n";
open(LS,"ls|") or die;
$i=0;
while($d=<LS>){
chomp($d);
next if ! -d $d;
next if ! -f "$d/desc";
$desc=`cat \"$d/desc\"`;
@desc=split /\s+/,$desc,3;
if ($i % 2){
print FD "<tr bgcolor=\"#606060\">\n";
}else{
print FD "<tr bgcolor=\"#505050\">\n";
}
print FD "<td><a href=\"".qu($desc[0])."\">".qh($desc[0])."</a> </td>";
print FD "<td>".qh($desc[1])." </td>";
print FD "<td><a href=\"".qu($desc[0])."\">".qh($desc[2])."</a> </td></tr>\n";
$i++;
}
close(LS);
print FD "</table>
<p>Created by listdir.pl, part of <a href=\"http://tucnak.nagano.cz\">TUCNAK</a> ver. 1.23</p>
<p>
<a href=\"http://validator.w3.org/check/referer\">
<img border=\"0\" src=\"valid-html401.png\"
alt=\"Valid HTML 4.01!\" height=\"31\" width=\"88\"></a>
<a href=\"http://www.anybrowser.org/campaign/\"><img src=\"bestviewed.gif\" alt=\"Viewable with any browser\" width=\"80\" height=\"31\" border=\"0\"></a> </p><br><br>
</center></body></html>\n";
sub qh{
my ($s)=@_;
return "" if !defined($s);
$s=~s/\&/&/g;
$s=~s/\"/"/g;
$s=~s/\'/'/g;
$s=~s/\</</g;
$s=~s/\>/>/g;
return $s;
}
sub qu #taken from URI:Escape.pm, sub uri_escape
{
my($text, $patn) = @_;
if (!defined(%escapes)){
# Build a char->hex map
for (0..255) {
$escapes{chr($_)} = sprintf("%%%02X", $_);
}
}
return undef unless defined $text;
if (defined $patn){
unless (exists $subst{$patn}) {
# Because we can't compile the regex we fake it with a cached sub
(my $tmp = $patn) =~ s,/,\\/,g;
eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";
Carp::croak("uri_escape: $@") if $@;
}
&{$subst{$patn}}($text);
} else {
# Default unsafe characters. RFC 2732 ^(uric - reserved)
$text =~ s/([^A-Za-z0-9\-_.!~*'()])/$escapes{$1} || _fail_hi($1)/ge;
}
$text;
}
|
