diff --git a/trunk/apache.conf b/trunk/apache.conf
index bc57f10..91f1582 100644
--- a/trunk/apache.conf
+++ b/trunk/apache.conf
@@ -15,8 +15,8 @@ NameVirtualHost *
AllowEncodedSlashes On
RewriteEngine On
- RewriteRule ^/video/(.*)/([0-9]*)/(.*)$ /video.pl?title=$1&id=$2&$3
- RewriteRule ^/embedded/(.*)/([0-9]*)/(.*)$ /video.pl?title=$1&id=$2&embed=true&$3
+ RewriteRule ^/video/(.*)/([0-9]+)/(.*)$ /video.pl?title=$1&id=$2&$3
+ RewriteRule ^/embedded/(.*)/([0-9]+)/(.*)$ /video.pl?title=$1&id=$2&embed=true&$3
RewriteRule ^/download/([0-9]+)/(.*)$ /download.pl?id=$1&$2
ErrorLog /var/log/apache2/error.log
diff --git a/trunk/functions.pl b/trunk/functions.pl
index 0a4a620..1653836 100644
--- a/trunk/functions.pl
+++ b/trunk/functions.pl
@@ -235,9 +235,6 @@ sub urlencode
sub output_page
{
- use XML::LibXSLT;
- use XML::LibXML;
-
my $parser = XML::LibXML->new();
my $xslt = XML::LibXSLT->new();
@@ -303,6 +300,7 @@ sub output_page
return $session->header(
-type=>$stylesheet->media_type,
-charset=>$stylesheet->output_encoding,
+ "x-pingback"=>$config->{"url_root"}."/pingback.pl"
),
$output->toString;
#$stylesheet->output_as_bytes($output); <= for future use with XML::LibXSLT (>= 1.62)
diff --git a/trunk/include.pl b/trunk/include.pl
index 6792a55..935d229 100644
--- a/trunk/include.pl
+++ b/trunk/include.pl
@@ -7,8 +7,12 @@ use XML::Simple qw(:strict);
use Digest::SHA qw(sha256_hex);
use LWPx::ParanoidAgent;
use Net::OpenID::Consumer;
-use CGI::Carp qw(fatalsToBrowser set_message);
use File::Copy;
+use XML::LibXSLT;
+use XML::LibXML;
+use LWP::UserAgent;
+use HTTP::Request;
+use CGI::Carp qw(fatalsToBrowser set_message);
set_message("It's not a bug, it's a feature!!
(include this error message in your bugreport here: Yolanda bugtracker)");
diff --git a/trunk/init_sql.pl b/trunk/init_sql.pl
index 1eaf2f1..522f1eb 100644
--- a/trunk/init_sql.pl
+++ b/trunk/init_sql.pl
@@ -117,7 +117,19 @@ $dbh->do(qq{create table
id int auto_increment not null,
userid int not null,
videoid int not null,
- text varchar(255) not null,
+ text text not null,
+ timestamp bigint not null,
+ primary key (id)
+ )
+}) or die $dbh->errstr;
+
+$dbh->do(qq{create table
+ pingbacks
+ (
+ id int auto_increment not null,
+ source varchar(255) not null,
+ videoid int not null,
+ text text not null,
timestamp bigint not null,
primary key (id)
)
diff --git a/trunk/pingback.pl b/trunk/pingback.pl
new file mode 100644
index 0000000..533311d
--- /dev/null
+++ b/trunk/pingback.pl
@@ -0,0 +1,137 @@
+require "functions.pl";
+
+#initialize session data
+CGI::Session->name($config->{"page_cookie_name"});
+$query = new CGI;
+$session = new CGI::Session;
+
+if ($query->param("POSTDATA"))
+{
+ my $xmlpost = XMLin($query->param("POSTDATA"), ForceArray => 0, KeyAttr => 0);
+
+ if (!$@)
+ {
+ my $method = $xmlpost->{"methodName"};
+ my $source = $xmlpost->{"params"}->{"param"}[0]->{"value"}->{"string"};
+ my $target = $xmlpost->{"params"}->{"param"}[1]->{"value"}->{"string"};
+
+ if ($method eq "pingback.ping")
+ {
+ if ($source =~ /^http:\/\// and $target =~ /^http:\/\//)
+ {
+ #fetch the source URI to verify that the source does indeed link to the target.
+ my $request = HTTP::Request->new(GET => $source);
+ my $ua = LWP::UserAgent->new;
+ my $response = $ua->request($request);
+
+ if ($response->is_success)
+ {
+ #TODO: sanitize regex to grep site content
+ if (my ($text) = $response->content =~ m/(\S*.{0,17}$target.{0,17}\S*)/)
+ {
+ #check data to ensure that the target exists and is a valid entry.
+ my ($vid) = $target =~ /^$config->{'url_root'}\/video\/.*\/(\d+)\/.*/;
+
+ my $sth = $dbh->prepare("select id from videos where id = ? limit 1");
+ my $rowcount = $sth->execute($vid) or die $dbh->errstr;
+
+ $sth->finish() or die $dbh->errstr;
+
+ if ($rowcount)
+ {
+ #check that the pingback has not already been registered.
+ $sth = $dbh->prepare("select id from pingbacks where videoid = ? limit 1");
+ $rowcount = $sth->execute($vid) or die $dbh->errstr;
+ $sth->finish() or die $dbh->errstr;
+
+ if ($rowcount eq "0E0")
+ {
+ #record the pingback.
+ $dbh->do(qq{insert into pingbacks (source, videoid, text, timestamp) values (?, ?, ?, unix_timestamp())}, undef,
+ $source, $vid, $text) or die $dbh->errstr;
+
+ my $xml = ();
+ $xml->{'params'}->{'param'}->{'value'}->{'string'} = ["Pingback from $source to $target registered. Keep the web talking! :-)"];
+
+ print $session->header(
+ -type=>'application/xml',
+ -charset=>'UTF-8',
+ );
+
+ print XMLout(
+ $xml,
+ XMLDecl => 1,
+ KeyAttr => {},
+ RootName => 'methodResponse'
+ );
+ }
+ else
+ {
+ send_error(48, "The pingback has already been registered.");
+ }
+ }
+ else
+ {
+ send_error(33, "The specified target URI cannot be used as a target.");
+ }
+ }
+ else
+ {
+ send_error(17, "The source URI does not contain a link to the target URI, and so cannot be used as a source.");
+ }
+ }
+ else
+ {
+ send_error(16, "The source URI does not exist.");
+ }
+ }
+ else
+ {
+ send_error(-32602, "server error. invalid method parameters");
+ }
+ }
+ else
+ {
+ send_error(-32601, "server error. requested method not found");
+ }
+ }
+ else
+ {
+ send_error(-32700,"parse error. not well formed");
+ }
+}
+else
+{
+ print $session->header;
+ print "XML-RPC server only accepts POST requests with http content-type defined.";
+}
+
+sub send_error
+{
+ my ($faultCode, $faultString) = @_;
+
+ my $xml = ();
+ push @{$xml->{'fault'}->{'value'}->{'struct'}->{'member'}},
+ {
+ "name" => ["faultCode"],
+ "value" => [$faultCode]
+ };
+ push @{$xml->{'fault'}->{'value'}->{'struct'}->{'member'}},
+ {
+ "name" => ["faultString"],
+ "value" => [$faultString]
+ };
+
+ print $session->header(
+ -type=>'application/xml',
+ -charset=>'UTF-8',
+ );
+
+ print XMLout(
+ $xml,
+ XMLDecl => 1,
+ KeyAttr => {},
+ RootName => 'methodResponse'
+ );
+}
+
diff --git a/trunk/video.pl b/trunk/video.pl
index b4dee3d..07b2bf7 100644
--- a/trunk/video.pl
+++ b/trunk/video.pl
@@ -76,10 +76,75 @@ if($query->url_param('id'))
#output infobox
$page->{'message'}->{'type'} = "information";
$page->{'message'}->{'text'} = "information_comment_created";
-
+
#add to database
$dbh->do(qq{insert into comments (userid, videoid, text, timestamp) values (?, ?, ?, unix_timestamp())}, undef,
$userinfo->{'id'}, $id, $query->param('comment')) or die $dbh->errstr;
+
+ #send pingbacks to every url in the comment
+ my (@matches) = $query->param('comment') =~ /(http:\/\/\S+)/gi;
+ foreach $match (@matches)
+ {
+ #ask for http header only - if pingbacks are implemented right, then we wont need the full site
+ my $request = HTTP::Request->new(HEAD => $match);
+ my $ua = LWP::UserAgent->new;
+
+ my $response = $ua->request($request);
+
+ if ($response->is_success)
+ {
+ my $pingbackurl = $response->header("x-pingback");
+
+ #if there was no x-pingback header, fetch the website and search for link element
+ if (!$pingbackurl)
+ {
+ $request = HTTP::Request->new(GET => $match);
+ $response = $ua->request($request);
+
+ if ($response->is_success)
+ {
+ ($pingbackurl) = $response->content =~ //;
+ }
+ }
+
+ #if requests were successful, send the pingbacks
+ if ($pingbackurl)
+ {
+ #TODO: expand xml entities < > & " in $pingbackurl
+
+ #contruct the xml-rpc request
+ my $xmlpost->{"methodName"} = ["pingback.ping"];
+ push @{$xmlpost->{'params'}->{'param'} },
+ {
+ "value" =>
+ {
+ "string" => [$config->{"url_root"}."/video/".urlencode($title)."/$id/"]
+ }
+ };
+ push @{$xmlpost->{'params'}->{'param'} },
+ {
+ "value" =>
+ {
+ "string" => [$match]
+ }
+ };
+
+ #post a xml-rpc request
+ $request = HTTP::Request->new(POST => $pingbackurl);
+ $request->header('Content-Type' => "application/xml");
+ $request->content(XMLout(
+ $xmlpost,
+ XMLDecl => 1,
+ KeyAttr => {},
+ RootName => 'methodCall'
+ ));
+ $ua = LWP::UserAgent->new;
+ $response = $ua->request($request);
+ print $response->content;
+ #TODO: maybe do something on success?
+ }
+ }
+ }
}
}
diff --git a/trunk/xsl/xhtml/xhtml-head.xsl b/trunk/xsl/xhtml/xhtml-head.xsl
index ce2f8f8..2010582 100644
--- a/trunk/xsl/xhtml/xhtml-head.xsl
+++ b/trunk/xsl/xhtml/xhtml-head.xsl
@@ -39,6 +39,9 @@
+
+
+