- html - 出于某种原因,IE8 对我的 Sass 文件中继承的 html5 CSS 不友好?
- JMeter 在响应断言中使用 span 标签的问题
- html - 在 :hover and :active? 上具有不同效果的 CSS 动画
- html - 相对于居中的 html 内容固定的 CSS 重复背景?
我所有的应用程序都是用 PHP 编写的,bar 1 脚本恰好创建了一个 md5 散列,稍后通过 PHP 脚本使用。问题是它们不匹配。
PERL:
#$linkTrue = 'http://www.themobilemakeover.co.uk/mobile-makeover-appointment-booking-signup.php'
md5_hex($linkTrue);
出于测试目的,我在 PHP 中做了这个:
echo md5("http://www.themobilemakeover.co.uk/mobile-makeover-appointment-booking-signup.php");
两者都返回不同的值。有谁知道这是为什么吗?
编辑:整个 PHP 脚本
<?php
echo md5("http://www.themobilemakeover.co.uk/mobile-makeover-appointment-booking-signup.php");
?>
完整的 PERL 脚本(抱歉太长了)
#!/usr/bin/perl
use strict;
use warnings;
use LWP::Simple;
require LWP::UserAgent;
sub trim($);
use DBI;
use Net::FTP;
use Digest::MD5 qw(md5 md5_hex md5_base64);
print "Content-type: text/html\n\n";
print "<html>\n<head>\n</head><body>\n";
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
$ua->env_proxy;
$ua->max_redirect(0);
#my %get = ();
#for (split /\&/, $ENV{'QUERY_STRING'}) { my ($key, $val) = split /=/; $val =~ s/\+/ /g; $val =~ s/%([0-9a-fA-F]{2})/chr(hex($1))/ge; $get{$key} = $val; }
#my %post = ();
#for (split /\&/, <STDIN>) { my ($key, $val) = split /=/; $val =~ s/\+/ /g; $val =~ s/%([0-9a-fA-F]{2})/chr(hex($1))/ge; $post{$key} = $val; }
my %get = ('findAllPages' => 'true' );
my %post = ('ki' => '############################' );
sub trim($){
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
sub extention {
my($data) = @_;
if( substr( trim($data), -1) eq "/" ){
my @extArray = ('.html', '.php', '.htm', '.asp', '.shtml', '.aspx');
foreach(@extArray){
my $ext = $_;
my $testResponse = $ua->get('http://' . trim($data . "index" . $ext));
my $testResponseCode = $testResponse->code;
if( $testResponseCode == 200 || $testResponseCode == 301 || $testResponseCode == 302 ){
return trim($data . "index" . $ext);
last;
}
}
}else{
return $data;
}
}
if( defined( $get{findAllPages} ) && defined( $post{ki} ) ){
my ($database, $hostname, $port, $password, $user );
$database = "##########";
$hostname = "############";
$password = "##########";
$user = "#########";
my $KI = $post{ki};
# connect to the database
my $dsn = "DBI:mysql:database=$database;host=$hostname;";
my $dbh = DBI->connect($dsn, $user, $password);
my $sth = $dbh->prepare("SELECT * FROM accounts WHERE KI = '$KI' ") or die "Could not select from table" . $DBI::errstr;
$sth->execute();
if( $sth->rows != 0 ) {
my $ref = $sth->fetchrow_hashref();
my $domain = $ref->{website};
my $DB_username = $ref->{db_name};
my $DB_password = $ref->{db_pass};
my $DB_ftpuser = $ref->{ftpuser};
my $DB_ftppass = $ref->{ftppass};
my $DB_ftpserver = $ref->{ftpserver};
$sth->finish();
$dbh->disconnect();
chomp(my $url = trim($domain));
# try and find full path
sub findFullPath {
my($link, $landingPage) = @_;
# strip ./ and / from beggining of string
$link =~ s/^(?:(?:\/)|(?:\.\/))//g;
# find out whether link is backtracing to previous folder
if( $link =~ m/^\.\.\// ) { # link desination is back tracing
if( $landingPage =~ m/(?:(?:\.html)|(?:\.php)|(?:\.htm)|(?:\.asp)|(?:\.shtml)|(?:\.aspx))$/g ) {
# find destination folder from landing page
my @folders = split( "/", $landingPage );
#find size of array
my $foldersSize = scalar @folders;
delete $folders[$foldersSize - 1];
$foldersSize = scalar @folders;
my @backFolders = ( $link =~ m/\.\.\//g ); # get rid of ../
my $amountOfBackFolders = scalar @backFolders; # find how many folders back
for( my $x=0; $x < $amountOfBackFolders; $x++ ) {
my $numberToDelete = ($foldersSize - 1) - $x;
delete $folders[$numberToDelete];
}
$landingPage = join( "/", @folders );
$link =~ s/\.\.\///g;
return $landingPage . "/" . $link . "\n";
} elsif( $landingPage =~ m/(?:\/)$/g ) {
my @folders = split( "/", $landingPage );
#find size of array
my $foldersSize = scalar @folders;
delete $folders[$foldersSize - 1];
$foldersSize = scalar @folders;
my @backFolders = ( $link =~ m/\.\.\//g ); # get rid of ../
my $amountOfBackFolders = scalar @backFolders; # find how many folders back
for( my $x=0; $x < $amountOfBackFolders; $x++ ) {
my $numberToDelete = ($foldersSize) - $x;
delete $folders[$numberToDelete];
}
$landingPage = join( "/", @folders );
$link =~ s/\.\.\///g;
return $landingPage . "/" . $link . "\n";
} else {
}
}else{
if( substr( $landingPage, -1) eq "/" ){
return $landingPage . $link;
}else{
my @splitLandingPage = split( "/", $landingPage );
my $amountSplit = scalar @splitLandingPage;
my $toDelete = $amountSplit - 1;
my $lastEntry = $splitLandingPage[$toDelete];
if( $lastEntry =~ m/(?:(?:com)|(?:co\.uk)|(?:net)|(?:org)|(?:cc)|(?:tv)|(?:info)|(?:org\.uk)|(?:me\.uk)|(?:biz)|(?:name)|(?:eu)|(?:uk\.com)|(?:eu\.com)|(?:gb\.com)|(?:gb\.net)|(?:uk\.net)|(?:me)|(?:mobi))$/g ) {
return join( "/", @splitLandingPage ) . "/" . $link . "\n";
}else{
delete $splitLandingPage[$toDelete];
return join( "/", @splitLandingPage ) . "/" . $link . "\n";
}
}
}
}
# get HTTP details
my $response = $ua->get('http://' . trim($url));
my $responseCode = $response->code;
my $responseLocation = $response->header( 'Location' );
# contintue only if status code is 200 or 301
if( $responseCode != 200 && $responseCode != 301 && $responseCode != 302 ){
print "<span class=\"red\"> error: http://" . trim($url) . "Domain name invalid, please use differnet domain name: http status - " . $responseCode . "</span><br />\n";
die;
}
# change url if domain status eq 301
if( $responseCode == 301 || $responseCode == 302 ){
if($response->header( 'Location' ) =~ m/^http:\/\/www\./g ) {
$url = substr( $response->header( 'Location' ), 11 );
}elsif($response->header( 'Location' ) =~ m/^http:\/\//g ) {
$url = substr( $response->header( 'Location' ), 7 );
}else{
$url = findFullPath($response->header( 'Location' ), $url);
}
}
my @pagesArray = ($url);
my @pagesScannedArray;
my @mainPagesArray;
my @pagesNotScanned;
my $z = 0;
#print "\nGethering all valid links from " . $domain . "...\n\n";
while ( @pagesArray && $z < 100 ) {
# get the next in queue for proccessing
my $page = trim(shift @pagesArray);
if( ! grep {$_ eq trim($page)} @pagesNotScanned ) {
# check page http status
$response = $ua->get("http://" . trim($page));
$responseCode = $response->code;
if( $responseCode == 200 || $responseCode == 301 || $responseCode == 302 ){
# change page url if 301 redirect
if( $responseCode == 301 || $responseCode == 302 ){
if($response->header( 'Location' ) =~ m/^http:\/\/www\./g ) {
$page = substr( $response->header( 'Location' ), 11 );
}elsif($response->header( 'Location' ) =~ m/^http:\/\//g ) {
$page = substr( $response->header( 'Location' ), 7 );
}else{
$page = findFullPath($response->header( 'Location' ), $url);
}
}
# connect to page and get contents
if( my $pageData = get "http://" . trim($page) ) {
# get all links on page
my @pageLinksArray = ( $pageData =~ m/href=["']([^"']*)["']/g );
# foreach link on the page
foreach( @pageLinksArray ) {
my $link = trim($_);
# remove url if located on same domain
$link =~ s/(?:http:\/\/)?(?:www\.)?$url//g;
# if link is format we are looking for
if( $link =~ m/(?:(?:\.html)|(?:\.php)|(?:\.htm)|(?:\.asp)|(?:\.shtml)|(?:\.aspx)|(?:\/))$/ ) {
# if link is outbound
if( $link =~ m/^http:\/\//g ) {
if( ! grep {$_ eq trim($link)} @pagesNotScanned ) {
if( ! grep {$_ eq trim($page)} @mainPagesArray ) {
push ( @pagesNotScanned, trim($link) );
}
}
}else{
# find full path for link
my $newUrl = &findFullPath(trim($link), trim($page));
# if link has not already been claimed to be a main page
if( ! grep {$_ eq trim($newUrl)} @mainPagesArray ) {
# if link is not already in queue
if( ! grep {$_ eq trim($newUrl)} @pagesArray ) {
push ( @pagesArray, trim($newUrl) );
}
}
}
}
}
if( ! grep {$_ eq trim($page)} @mainPagesArray ) {
push ( @mainPagesArray, trim($page) );
}
}
}else{
if( ! grep {$_ eq trim($page)} @pagesNotScanned ) {
if( ! grep {$_ eq trim($page)} @mainPagesArray ) {
push ( @pagesNotScanned, trim($page) );
}
}
}
}
$z++;
}
if( scalar @mainPagesArray != 0 ) {
my ($database, $hostname, $port, $password, $user );
$database = $DB_username;
$hostname = "###########";
$password = $DB_password;
$user = $DB_username;
# connect to the database
my $dsn = "DBI:mysql:database=$database;host=$hostname;";
my $dbh = DBI->connect($dsn, $user, $password) or die " error: Couldn't connect to database: " . DBI->errstr;
print "\nTesting links' extentions from " . $domain . "...\n\n";
my $root;
my $ftp = Net::FTP->new($DB_ftpserver, Debug => 0) or die "Cannot connect to some.host.name: $@";
$ftp->login($DB_ftpuser, $DB_ftppass) or die "Cannot login ", $ftp->message;
my @list = $ftp->dir;
if( scalar @list != 0 ) {
foreach( @list ){
if( $_ =~ m/((?:www)|(?:public_html)|(?:htdocs))$/g ){
$root = $1;
last;
}
}
}
if( $root eq "" ) {
print "error: could not identify root directory.<br />\n";
die;
}
foreach( @mainPagesArray ) {
my $webpage = &extention(trim($_));
if( trim($webpage) ne trim($domain) ){
my $webpageQuote = $dbh->quote("http://www." . $webpage);
my $sth = $dbh->prepare("SELECT * FROM page_names WHERE linkTrue = $webpageQuote ") or die "Could not select from table" . $DBI::errstr;
$sth->execute();
if( $sth->rows == 0 ) {
print "http://www." . $webpage . "<br />\n";
my $linkTrue = $dbh->quote("http://www." . $webpage);
my $string = ($webpage =~ s/^$domain//g);
my $linkFromRoot = $dbh->quote($root . $webpage);
my $page_name = $dbh->quote("");
my $table_name = $dbh->quote(md5_hex(trim($linkTrue)));
my $navigation = $dbh->quote("");
my $location = $dbh->quote("");
$dbh->do("INSERT INTO page_names (linkFromRoot, linkTrue, page_name, table_name, navigation, location) VALUES ( $linkFromRoot, $linkTrue, $page_name, $table_name, $navigation, $location )") or die " error: Couldn't connect to database: " . DBI->errstr;
}
}
}
}else{
print "<span class=\"red\"> error: No pages where found. This CMS is designed for pre-existing sites. Please contact support for more information.</span><br />\n";
}
}else{
print "<span class=\"red\"> error: input key incorrerct.</span><br />\n";
}
}else{
print "<span class=\"red\"> error: This area is forbidden please locate back to www.plugnplaycms.co.uk</span><br />\n";
}
print "</body>\n</html>";
我相信它在第 274 行。代码可能很乱,但它是我的第一个 perl 脚本,只用了一个星期。
我知道了。 $dbh->quote() 在值周围添加单引号。
http://www.themobilemakeover.co.uk/index.php
十六进制:58030da397e8a071bc192e67744faeb3 值:['http://www.themobilemakeover.co.uk/index.php '] http://www.themobilemakeover.co.uk/about-us-the-mobile-makeover.php
十六进制:569c081a2974da39758a3cbf3c3407d2 值:['http://www.themobilemakeover.co.uk/about-us-the-mobile-makeover.php '] http://www.themobilemakeover.co.uk/beauty-products-used.php
十六进制:ac94f84cf6b27bca0c23cd6b0e0f1fc9 值:['http://www.themobilemakeover.co.uk/beauty-products-used.php '] http://www.themobilemakeover.co.uk/beauty-treatments.php
十六进制:e88d7e8e16ffc0a72b56a884d4c6c06b 值:['http://www.themobilemakeover.co.uk/beauty-treatments.php '] http://www.themobilemakeover.co.uk/contact.php
十六进制:8924fa24bdde1c4e072f99826d957b77 值:['http://www.themobilemakeover.co.uk/contact.php '] http://www.themobilemakeover.co.uk/pamper-parties.php
十六进制:1f2fae70048359734a9d1b3ca29cce55 值:['http://www.themobilemakeover.co.uk/pamper-parties.php '] http://www.themobilemakeover.co.uk/mobile-makeover-appointment-booking.php
十六进制:9961f75109590c3924e4018768ecd44e 值:['http://www.themobilemakeover.co.uk/mobile-makeover-appointment-booking.php '] http://www.themobilemakeover.co.uk/sitemap/index.php
十六进制:fbca4996156b038f4635467ee13e1615 值:[' http://www.themobilemakeover.co.uk/sitemap/index.php '] http://www.themobilemakeover.co.uk/accessibility/index.php
十六进制:6f03046cbe90c490e4993c5325a44aa7 值:['http://www.themobilemakeover.co.uk/accessibility/index.php '] http://www.themobilemakeover.co.uk/terms/index.php
十六进制:5304b5e9bd933fb920a4f8749c27094b 值:['http://www.themobilemakeover.co.uk/terms/index.php '] http://www.themobilemakeover.co.uk/beauty-treatments2.php
十六进制:96225fa657ef60b4969d277d01d8b577 值:['http://www.themobilemakeover.co.uk/beauty-treatments2.php '] http://www.themobilemakeover.co.uk/beauty-treatments3.php
十六进制:327c1bc37354aad202c90efe0dfa756b 值:['http://www.themobilemakeover.co.uk/beauty-treatments3.php '] http://www.themobilemakeover.co.uk/wedding-and-special-occasions.php
十六进制:54c074a1881a0c958c7c2b8ff88f63d6 值:['http://www.themobilemakeover.co.uk/wedding-and-special-occasions.php '] http://www.themobilemakeover.co.uk/mobile-makeover-appointment-booking-signup.php
十六进制:486c944b10ef539aa7ba4bfe607861f2 值:['http://www.themobilemakeover.co.uk/mobile-makeover-appointment-booking-signup.php ']
最佳答案
当我尝试时,两个程序都返回 a4cbeef10b3c6d44ca30d96370619eef
我觉得您没有向我们展示全部情况。向我们展示导致此问题的代码。特别是检查换行符。你在 perl 脚本中使用过 chomp 吗?
自己试试吧。这是我使用的完整 php 脚本:
<?php
echo md5("http://www.themobilemakeover.co.uk/mobile-makeover-appointment-booking-signup.php");
?>
这是我使用的完整 perl 脚本:
#!/usr/bin/perl
use Digest::Perl::MD5 'md5_hex';
$linkTrue = 'http://www.themobilemakeover.co.uk/mobile-makeover-appointment-booking-signup.php';
print md5_hex($linkTrue);
编辑:
如果这两个脚本没有为 md5 返回那个值呢?那是有错误的那个。记录您传递给 md5 的值(在前面使用“[”,在后面使用“]”来检测额外的空格)。该值是否符合您的预期?
编辑 2:
看起来你找到了,对吧?这是单引号。这:
print md5_hex("'http://www.themobilemakeover.co.uk/mobile-makeover-appointment-booking-signup.php'");
注意额外的引号。上面一行给我:486c944b10ef539aa7ba4bfe607861f2
关于php - 比较 PERL md5() 和 PHP md5(),我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/2212670/
如果我的 Perl 程序使用 Perl 模块,它将如何确定在哪里可以找到包含模块代码的文件? 例如,如果程序包含: use MyModule1; # Example 1 us
我在一个文件中有一些不同格式的数字:8.3、0.001、9e-18。我正在寻找一种简单的方法来读取它们并存储它们而不会损失任何精度。这在 AWK 中很容易,但在 Perl 中是如何完成的呢?我只愿意使
我在一个文件中有一些不同格式的数字:8.3、0.001、9e-18。我正在寻找一种简单的方法来读取它们并存储它们而不会损失任何精度。这在 AWK 中很容易,但在 Perl 中是如何完成的呢?我只愿意使
我正在自学 Perl,并且在我的 Windows 8 64 位系统上安装了 Strawberry。 Strawberry 命令行似乎工作正常,我在 C 驱动器上的 Strawberry 文件夹中创建了
我在 Perl 模块 IO::Socket::SSL 中发现了一个错误,我可能会修复它,但是,我担心测试修复。我从 Debian 下载了源码包(因为我打算为它制作一个 Debian 包或补丁)并查看了
我有一个 perl 文件,它使用了两个 perl 模块 A.pm 和 B.pm。 但是在 B.pm 中我需要调用 A.pm 的子程序。即使我在 A.pm 中使用并尝试使用它,我仍然遇到未定义的错误。
有没有办法在 Perl 运行时加载整个模块?我原以为我用 autouse 找到了一个很好的解决方案,但以下代码无法编译: package tryAutouse2; use autouse 'tryAu
过去,我编写过许多 perl 模块,以及不止一些独立的 perl 程序,但我之前从未发布过多文件 perl 程序。 我有一个几乎处于 beta 阶段的 perl 程序,它将被开源发布。它需要一些数据文
我有 1 个 perl 脚本,我们在其中编写了几个子例程。例子: # Try_1.pl main(); sub main{ --- --- check(); } check { -- --} 现在,
似乎 CPAN 上的一些(很多?)模块部分是使用 XS 在 C 中实现的,如果需要,可以回退到纯 perl 实现。虽然这很聪明,但它显然会损害性能,我想知道它是否会发生,以便我可以解决问题。 有没有一
我对 perl 很陌生。我希望我可以从 perl 安装一些软件包,我这样做是这样的: perl -MCPAN -e 'install VM::EC2' 我猜它由于依赖而失败,它显示: Result:
给定一个 Perl 包 Foo.pm,例如 package Foo; use strict; sub bar { # some code here } sub baz { # more
我有一个用 Perl 编写的测试生成器。它生成连接到模拟器的测试。这些测试本身是用 Perl 编写的,并通过其 API 连接到模拟器。我希望生成的代码是人类可读的,这意味着我希望它能够正确缩进和格式化
我正在学习 Perl,非常新的用户。我可以知道这些 Perl 代码之间有什么区别吗? #!/usr/bin/perl & #!/usr/bin/perl -w 最佳答案 那不是 perl 代码,它是
我不认为这是一个重复的问题。这专门针对 Perl 模块附带的脚本。 通常,在安装多个 Perl 版本时,您可以将 perl 可执行文件标记为版本号 (perl5.32),这样它们就可以在 /whate
我有一个在文件中使用 Blowfish 加密的程序和第二个 perl 程序,它提示输入用于将其解密为字符串的密码,我希望不必将解密的源代码写入硬盘驱动器,尽管将它放在内存中并不是真正的问题,因为运行程
有没有人为 Perl 中的惰性求值列表找到了一个好的解决方案?我尝试了很多方法来改变类似的东西 for my $item ( map { ... } @list ) { } 进入懒惰的评估——例如,通
我安装了多个版本的 Perl。 我已经指定了要使用的版本。但是为了验证,我想从 .pl 脚本本身输出 Perl 的版本。 这可能吗? 在 Perl 脚本中解析“perl --version”的输出似乎
人们还经常问“我怎样才能编译 Perl?”而他们真正想要的是创建一个可以在机器上运行的可执行文件,即使他们没有安装 Perl。 我知道有几种解决方案: perl2exe靛蓝之星 它是商业的。我从未尝试
关闭。这个问题是opinion-based .它目前不接受答案。 想改进这个问题?更新问题,以便 editing this post 可以用事实和引用来回答它. 8年前关闭。 Improve this
我是一名优秀的程序员,十分优秀!