#!/usr/local/bin/perl ###################################################### #BooLinkMaker,v1.38 / this program is value software.# #(C) BooBooClub 1997-2011 # ###################################################### #set data $pass = 'pass'; $page='./links.html'; $back = 'bgcolor="#ffffff"'; #read lib require './jcode.pl'; #lock &lock; #read if ($ENV{'REQUEST_METHOD'} eq "POST"){ read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else{ $buffer = $ENV{'QUERY_STRING'}; } @pairs = split(/&/,$buffer); foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/\,//g; $value =~ s//>/ig; $value =~ s/\r\n|[\r\n]//ig; &jcode'convert(*value,'sjis'); $FORM{$name} = $value; } #branch if($FORM{'pass'} ne ""){ &remove; &html; } else{ &html; } sub remove{ if($pass ne $FORM{'pass'}){ &passerror; } open (DAT,"$page"); @link = ; close (DAT); $target = $FORM{'remove'}; $i = 0; foreach $link(@link){ if($link =~ /^
  • (.+?)<\/b><\/a>/){ $i++; } else{ push(@ndat,$link); } } if($i != 1){ &remerror; } open (DAT,">$page"); print DAT @ndat; close (DAT); } sub html{ open (DAT,"$page"); @link = ; close (DAT); print "Content-type:text/html\n\n"; print ''."\n"; print ''."\n"; print "BooLinkMaker_AdminPage\n"; print "\n"; print "
    BooLinkMaker AdminPage

    \n"; print '
    ',"\n"; print '
    ',"\n"; if($FORM{'pass'}){ print '
    Password:   ',"\n"; } else{ print '
    Password:   ',"\n"; } print '

    ',"\n"; foreach $link(@link){ if($link =~ /^
  • (.+?)<\/b><\/a>/){ print '  ',"$2",'
    ',"\n"; } elsif($link =~ //){ print '
    ',"\n"; } } print '
  • ',"\n"; print '
    ',"\n"; print "
    \n"; print "\n"; unlink("$lockfile"); exit 0; } sub passerror{ print "Content-type:text/html\n\n"; print ''."\n"; print ''."\n"; print "Error\n"; print "

    不正なパスワードです

    \n"; print "ブラウザのバックボタンで戻って下さい
    \n"; print "\n"; unlink("$lockfile"); exit 0; } sub remerror{ print "Content-type:text/html\n\n"; print ''."\n"; print ''."\n"; print "Remove Error\n"; print "

    削除対象を特定できませんでした

    \n"; print "ブラウザのバックボタンで戻って下さい
    \n"; print "\n"; unlink("$lockfile"); exit 0; } print "Location: $reload\n\n"; unlink("$lockfile"); exit 0; sub lock{ $lockfile='./lock/lockfile'; $retry = 1; until (symlink("$page", "$lockfile")) { if (++$retry >= 30) { unlink("$lockfile"); exit 0; } sleep(1); } }