Введение.

Perl - Practical Extraction and Report Language (или Phatologically Eclectic Rubbish Lister).

• Программа Hello.
• Выбор.
• Секретное слово.
• Несколько секретных слов.
• Использование таблицы секретных слов - хеш.
• Обработка различных вариантов ввода.
• Использование подпрограмм.
• Работа с файлами.
• Повышение уровня безопастности.
• Предупреждение о попытке доступа.
• Несколько файлов секретных слов в текущем каталоге.
• Распечатка списка секретных слов.
• Переименование файлов, содержащих старые пароли.
• Ведение базы данных.
• Окончательный вариант программ.

Программа Hello.

#!/usr/local/bin/perl -w
use 5.004;
use strict;
print "What is you name? ";
$main::name = <STDIN> ;
chomp($main::name);
print "Hello, $main::name! \n";

Выбор.

#!/usr/local/bin/perl -w
print "What is you name? ";
$name = <STDIN> ;
chomp($name);
if($name eq "German") {
 print "Hello, German! Good of you to be here!\n";
} else {
 print "Hello, $name! \n";
}

Секретное слово.

#!/usr/local/bin/perl -w
print "What is you name? ";
$name = <STDIN> ;
chomp($name);
$secretword = "hmm";
if($name eq "German") {
 print "Hello, German! Good of you to be here!\n";
} else {
 print "Hello, $name! \n";
 print "What is the secret word? ";
 $guess = <STDIN> ;
 while($guess ne $secretword) {
 print "Wrong, try again. What is the secret word? ";
 $guess = <STDIN> ;
 chomp($guess); 
 }
}

Несколько секретных слов.

#!/usr/local/bin/perl -w
@words = qw(camel lama aplaca); # Perl 5.004
print "What is you name? ";
$name = <STDIN> ;
chomp($name);
if($name eq "German") {
 print "Hello, German! Good of you to be here!\n";
} else {
 print "Hello, $name! \n";
 print "What is the secret word? ";
 $guess = <STDIN> ;
 $i = 0;
 $correct = "maybe";
 while($correct eq "maybe") {
 if($words[$i] eq "guess) {
 $correct = "yes";
 } elsif($i < 2) {
 $i = $i + 1;
 } else {
 print "Wrong, try again. What is the secret word? ";
 $guess = <STDIN> ;
 chomp($guess); 
 $i = 0;
 }
 }
}

Использование таблицы секретных слов - хеш.

#!/usr/local/bin/perl	# did not use -w becouse ""
%words = qw( #Perl 5.004
 fred camel
 bamey llama
 betty alpaca
 irina alpaca
);
print "What is you name? ";
$name = <STDIN> ;
chomp ($name);
if($name eq "German") {
 print "Hello, German! How good of you to be here!\n";
} else {
 print "Hello, $name! \n";
 $secretword = $words{$name};
 if($secretword eq "") {
 $secretword = "grouhno";
 }
 print "What is the secret word? ";
 $guess = <STDIN> ;
 chomp($guess);
 while($guess ne $secretword) {
 print "Wrong, try again. What is a secret word? ";
 $guess = <STDIN> ;
 chomp($guess);
 }
}

Обработка различных вариантов ввода.

#!/usr/local/bin/perl
%words = qw(		#Perl 5.004
	fred	camel
	bamey	llama
	betty	alpaca
	irina	alpaca
);
print "What is you name? ";
$name = <STDIN> ;
chomp ($name);
$original_name = $name;
$name =~ s/\W.*//;
$name =~ tr/A-Z/a-z/;
if($name eq "german") {
	print "Hello, German! How good of you to be here!\n";
} else {
	print "Hello, $original_name! \n";
	$secretword = $words{$name};
	if($secretword eq "") {
		$secretword = "grouhno";
	}
	print "What is the secret word? ";
	$guess = <STDIN> ;
	chomp($guess);
	while($guess ne $secretword) {
		print "Wrong, try again. What is a secret word? ";
		$guess = <STDIN> ;
		chomp($guess);
	}
}

Использование подпрограмм.

#!/usr/local/bin/perl -w
%words = qw(
	fred	camel
	bamey	llama
	betty	alpaca
	irina	alpaca
);
print "What is you name? ";
$name = <STDIN> ;
chomp ($name);
if($name =~ /^german\b/i) {
	print "Hello, German! How good of you to be here!\n";
} else {
	print "Hello, $name! \n";
	print "What is a secret word? ";
	$guess = <STDIN> ;
	chomp($guess);
	while(! good_word( $name, $guess )) {
		print "Wrong, try again. What is a secret word? ";
		$guess = <STDIN> ;
		chomp($guess);
	}
}

sub good_word {
	my($somename, $someguess) = @_;
	$somename =~ s/\W.*//;
	$somename =~ tr/A-Z/a-z/;
	if($somename eq "german") {
		return 1;
	} elsif(($words{$somename} || "grouhno") eq $someguess) {
		return 1;
	} else {
		return 0;
	}
}

Работа с файлами.

#!/usr/local/bin/perl -w
init_words();
print "What is you name? ";
$name = <STDIN> ;
chomp ($name);
if($name =~ /^german\b/i) {
	print "Hello, German! How good of you to be here!\n";
} else {
	print "Hello, $name! \n";
	print "What is a secret word? ";
	$guess = <STDIN> ;
	chomp($guess);
	while(! good_word( $name, $guess )) {
		print "Wrong, try again. What is a secret word? ";
		$guess = <STDIN> ;
		chomp($guess);
	}
}

sub good_word {
	my($somename, $someguess) = @_;
	$somename =~ s/\W.*//;
	$somename =~ tr/A-Z/a-z/;
	if($somename eq "german") {
		return 1;
	} elsif(($words{$somename} || "grouhno") eq $someguess) {
		return 1;
	} else {
		return 0;
	}
}

sub init_words {
	open(WORDLIST, "wordlist") || die "can't open wordlist: $!";
	while(defined($name = <WORDLIST>)) {
		chomp($name);
		$word = <WORDLIST> ;
		chomp($word);
		$words{$name} = $word;
	}
	close(WORDLIST) || die "could not close wordlist: $!";
}

Повышение уровня безопастности.

#!/usr/local/bin/perl -w
init_words();
print "What is you name? ";
$name = <STDIN> ;
chomp ($name);
if($name =~ /^german\b/i) {
	print "Hello, German! How good of you to be here!\n";
} else {
	print "Hello, $name! \n";
	print "What is a secret word? ";
	$guess = <STDIN> ;
	chomp($guess);
	while(! good_word( $name, $guess )) {
		print "Wrong, try again. What is a secret word? ";
		$guess = <STDIN> ;
		chomp($guess);
	}
}

sub good_word {
	my($somename, $someguess) = @_;
	$somename =~ s/\W.*//;
	$somename =~ tr/A-Z/a-z/;
	if($somename eq "german") {
		return 1;
	} elsif(($words{$somename} || "grouhno") eq $someguess) {
		return 1;
	} else {
		return 0;
	}
}

sub init_words {
	open(WORDLIST, "wordlist") || die "can't open wordlist: $!";
	if(-M WORDLIST >= 7.0) {
		die "Sorry, the wordlist is older than seven days.";
	}
	while($name = <WORDLIST>) {
		chomp($name);
		$word = <WORDLIST> ;
		chomp($word);
		$words{$name} = $word;
	}
	close(WORDLIST) || die "could not open wordlist: $!";
}

Предупреждение о попытке доступа.

#!/usr/local/bin/perl
init_words();
print "What is you name? ";
$name = <STDIN> ;
chomp ($name);
if($name =~ /^german\b/i) {
	print "Hello, German! How good of you to be here!\n";
} else {
	print "Hello, $name! \n";
	print "What is a secret word? ";
	$guess = <STDIN> ;
	chomp($guess);
	while(! good_word( $name, $guess )) {
		print "Wrong, try again. What is a secret word? ";
		$guess = <STDIN> ;
		chomp($guess);
	}
}

sub good_word {
	my($somename, $someguess) = @_;
	$somename =~ s/\W.*//;
	$somename =~ tr/A-Z/a-z/;
	if($somename eq "german") {
		return 1;
	} elsif(($words{$somename} || "grouhno") eq $someguess) {
		return 1;
	} else {
		open MAIL, "|mail gera";
		print MAIL "bad news: $somename guessed $someguess\n";
		close MAIL;
		return 0;
	}
}

sub init_words {
	open(WORDLIST, "wordlist") || die "can't open wordlist: $!";
	if(-M WORDLIST >= 7.0) {
		die "Sorry, the wordlist is older than seven days.";
	}
	while($name = <WORDLIST>) {
		chomp($name);
		$word = <WORDLIST> ;
		chomp($word);
		$words{$name} = $word;
	}
	close(WORDLIST) || die "could not open wordlist: $!";
}

Несколько файлов секретных слов в текущем каталоге.

#!/usr/local/bin/perl -w
init_words();
print "What is you name? ";
$name = <STDIN> ;
chomp ($name);
if($name =~ /^german\b/i) {
	print "Hello, German! How good of you to be here!\n";
} else {
	print "Hello, $name! \n";
	print "What is a secret word? ";
	$guess = <STDIN> ;
	chomp($guess);
	while(! good_word( $name, $guess )) {
		print "Wrong, try again. What is a secret word? ";
		$guess = <STDIN> ;
		chomp($guess);
	}
}

sub good_word {
	my($somename, $someguess) = @_;
	$somename =~ s/\W.*//;
	$somename =~ tr/A-Z/a-z/;
	if($somename eq "german") {
		return 1;
	} elsif(($words{$somename} || "grouhno") eq $someguess) {
		return 1;
	} else {
		open MAIL, "|mail gera";
		print MAIL "bad news: $somename guessed $someguess\n";
		close MAIL;
		return 0;
	}
}

sub init_words {
	while(defined($filename = glob("*.secret"))) {
		open(WORDLIST, $filename) || die "can't open wordlist: $!";
		if(-M WORDLIST >= 7.0) {
			die "Sorry, the wordlist is older than seven days.";
		}
		while($name = <WORDLIST>) {
			chomp($name);
			$word = <WORDLIST> ;
			chomp($word);
			$words{$name} = $word;
		}
		close(WORDLIST) || die "could not open wordlist: $!";
	}
}

Распечатка списка секретных слов.

#!/usr/local/bin/perl -w
while(defined($filename = glob("*.secret"))) {
	open(WORDLIST, $filename) || die "can't open wordlist: $!";
	if(-M WORDLIST >= 7.0) {
		die "Sorry, the wordlist is older than seven days.";
	}
	while($name = <WORDLIST>) {
		chomp($name);
		$word = <WORDLIST> ;
		chomp($word);
		write;
	}
	close(WORDLIST) || die "could not open wordlist: $!";
}
format STDOUT =
@<<<<<<<<<<<<<< @<<<<<<<< @<<<<<<
$filename, $name, $word
.
format STDOUT_TOP =
Page @<<
$%

Filename Nname Word
================ ========= =======
.

Переименование файлов, содержащих старые пароли.

sub init_words {
	while(defined($filename = glob("*.secret"))) {
		open(WORDLIST, $filename) || die "can't open wordlist: $!";
		if(-M WORDLIST >= 7.0) {
			rename($filename, "$filename.old") ||
				die "can't rename $filename to $filename.old: $! ";
		}
		while($name = <WORDLIST>) {
			chomp($name);
			$word = <WORDLIST> ;
			chomp($word);
			$words{$name} = $word;
		}
		close(WORDLIST) || die "could not open wordlist: $!";
	}
}

Ведение базы данных.

Ведение базы данных:

dbmopen(%last_good, "lastdb", 0666) || die "can't dbmopen lastdb: $!";
	$last_good{$name} = time;
dbmclose(%last_good) || die "can't dbmclose lastdb: $!";

Получение информации из базы данных:

#!/usr/local/bin/perl -w
dbmopen(%last_good, "lastdb", 0666) || die "can't dbmopen lastdb: $!";
foreach $name (sort key (%last_good)) {
	$when = $last_good{$name};
	$hours = (time() - $when) / 3600;
	write;
}

format STDOUT =
User @<<<<<<<<<<:	last correct guess was @<<< hour ago.
$name, $hours
.

Окончательный вариант программ.

Приветствие:

#!/usr/local/bin/perl -w
init_words();
print "What is you name? ";
$name = <STDIN> ;
chomp ($name);
if($name =~ /^german\b/i) {
	print "Hello, German! How good of you to be here!\n";
} else {
	print "Hello, $name! \n";
	print "What is a secret word? ";
	$guess = <STDIN> ;
	chomp($guess);
	while(! good_word( $name, $guess )) {
		print "Wrong, try again. What is a secret word? ";
		$guess = <STDIN> ;
		chomp($guess);
	}
}
dbmopen(%last_good, "lastdb", 0666) || die "can't dbmopen lastdb: $!";
$last_good{$name} = time;
dbmclose(%last_good) || die "can't dbmclose lastdb: $!";

sub good_word {
	my($somename, $someguess) = @_;
	$somename =~ s/\W.*//;
	$somename =~ tr/A-Z/a-z/;
	if($somename eq "german") {
		return 1;
	} elsif(($words{$somename} || "grouhno") eq $someguess) {
		return 1;
	} else {
		open MAIL, "|mail gera";
		print MAIL "bad news: $somename guessed $someguess\n";
		close MAIL;
		return 0;
	}
}

sub init_words {
	while(defined($filename = glob("*.secret"))) {
		open(WORDLIST, $filename) || die "can't open wordlist: $!";
		if(-M WORDLIST >= 7.0) {
			rename($filename, "$filename.old") ||
				die "can't rename $filename to $filename.old: $! ";
		}
		while($name = <WORDLIST>) {
			chomp($name);
			$word = <WORDLIST> ;
			chomp($word);
			$words{$name} = $word;
		}
		close(WORDLIST) || die "could not open wordlist: $!";
	}
}

Листер паролей:

#!/usr/local/bin/perl -w
while(defined($filename = glob("*.secret"))) {
	open(WORDLIST, $filename) || die "can't open wordlist: $!";
	if(-M WORDLIST >= 7.0) {
		die "Sorry, the wordlist is older than seven days.";
	}
	while($name = <WORDLIST>) {
		chomp($name);
		$word = <WORDLIST> ;
		chomp($word);
		write;
	}
	close(WORDLIST) || die "could not open wordlist: $!";
}
format STDOUT =
@<<<<<<<<<<<<<< @<<<<<<<< @<<<<<<
$filename, $name, $word
.
format STDOUT_TOP =
Page @<<
$%

Filename Nname Word
================ ========= =======
.

Программа последнего правильного ввода пароля:

#!/usr/local/bin/perl -w
dbmopen(%last_good, "lastdb", 0666) || die "can't dbmopen lastdb: $!";
foreach $name (sort keys (%last_good)) {
	$when = $last_good{$name};
	$hours = (time() - $when) / 3600;
	write;
}

format STDOUT =
User @<<<<<<<<<<:	last correct guess was @<<< hour ago.
$name, $hours
.