mark: A photo of Mark kneeling on top of the Taal Volcano in the Philippines. It was a long hike. (Default)
Mark Smith ([staff profile] mark) wrote in [site community profile] changelog2009-03-06 06:53 am

[dw-free] I&I: Cross-site use of <lj user> tags

[commit: http://hg.dwscoalition.org/dw-free/rev/f79dd602b888]

http://bugs.dwscoalition.org/show_bug.cgi?id=92

Add DW::External::User/DW::External::Site and use these for representing
external site links. Also update the HTML cleaner to render [foo.com profile] foo links correctly.

Patch by [staff profile] mark.

Files modified:
  • cgi-bin/DW/External/Site.pm
  • cgi-bin/DW/External/Site/InsaneJournal.pm
  • cgi-bin/DW/External/Site/LiveJournal.pm
  • cgi-bin/DW/External/Site/Unknown.pm
  • cgi-bin/DW/External/User.pm
  • cgi-bin/cleanhtml.pl
  • cgi-bin/ljlib.pl
  • htdocs/img/external/lj-userinfo.gif
--------------------------------------------------------------------------------
diff -r ce12338f02b8 -r f79dd602b888 cgi-bin/DW/External/Site.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/External/Site.pm	Fri Mar 06 06:53:49 2009 +0000
@@ -0,0 +1,82 @@
+#!/usr/bin/perl
+#
+# DW::External::Site
+#
+# This is a base class used by other classes to define what kind of things an
+# external site can do.  This class is actually responsible for instantiating
+# the right kind of class.
+#
+# Authors:
+#      Mark Smith <mark@dreamwidth.org>
+#
+# Copyright (c) 2009 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself.  For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::External::Site;
+
+use strict;
+use Carp qw/ croak /;
+use DW::External::Site::InsaneJournal;
+use DW::External::Site::LiveJournal;
+use DW::External::Site::Unknown;
+
+
+sub new {
+    my ( $class, %opts ) = @_;
+
+    my $site = delete $opts{site}
+        or croak 'site argument required';
+    croak 'invalid extra parameters'
+        if %opts;
+
+    # cleanup
+    $site =~ s/\r?\n//s;            # multiple lines is pain
+    $site =~ s!^(?:.+)://(.*)!$1!;  # remove proto:// leading
+    $site =~ s!^([^/]+)/.*$!$1!;    # remove /foo/bar.html trailing
+
+    # validate each part of the domain based on RFC 1035
+    my @parts = grep { /^[a-z][a-z0-9\-]*?[a-z0-9]$/ }
+                map { lc $_ }
+                split( /\./, $site );
+
+    # FIXME: rewrite this in terms of LJ::ModuleLoader or some better
+    # functionality so that daughter sites can add new external sites
+    # without having to modify this file directly.
+    
+    # now we see who's going to accept this... when editing, try to put
+    # common ones towards the top as this is likely to be run a bunch
+    if ( my $obj = DW::External::Site::LiveJournal->accepts( \@parts ) ) {
+        return $obj;
+
+    } elsif ( my $obj = DW::External::Site::InsaneJournal->accepts( \@parts ) ) {
+        return $obj;
+
+    } elsif ( my $obj = DW::External::Site::Unknown->accepts( \@parts ) ) {
+        # the Unknown class tries to fake it by emulating the general defaults
+        # we expect most sites to use.  if it doesn't work, someone should submit a
+        # patch to help us figure out what site they're using.
+        #
+        # do log the site though, so we can look at the logs later and maybe do it
+        # ourselves.
+        warn "Unknown site " . join( '.', @parts ) . " in DW::External::Site.\n";
+        return $obj;
+
+    }
+
+    # can't handle this in any way
+    return undef;
+}
+
+
+# these methods are expected to be implemented by the subclasses
+sub accepts         { croak 'unimplemented call to accepts';         }
+sub journal_url     { croak 'unimplemented call to journal_url';     }
+sub profile_url     { croak 'unimplemented call to profile_url';     }
+sub badge_image_url { croak 'unimplemented call to badge_image_url'; }
+
+
+1;
diff -r ce12338f02b8 -r f79dd602b888 cgi-bin/DW/External/Site/InsaneJournal.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/External/Site/InsaneJournal.pm	Fri Mar 06 06:53:49 2009 +0000
@@ -0,0 +1,77 @@
+#!/usr/bin/perl
+#
+# DW::External::Site::InsaneJournal
+#
+# Class to support the InsaneJournal.com site.
+#
+# Authors:
+#      Mark Smith <mark@dreamwidth.org>
+#
+# Copyright (c) 2009 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself.  For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::External::Site::InsaneJournal;
+
+use strict;
+use base 'DW::External::Site';
+use Carp qw/ croak /;
+
+
+# new does nothing for these classes
+sub new { croak 'cannot build with new'; }
+
+
+# returns 1/0 if we allow this domain
+sub accepts {
+    my ( $class, $parts ) = @_;
+
+    # allows anything at insanejournal.com
+    return 0 unless $parts->[-1] eq 'com' &&
+                    $parts->[-2] eq 'insanejournal';
+
+    return bless { hostname => 'insanejournal.com' }, $class;
+}
+
+
+# argument: DW::External::User
+# returns URL to this account's journal
+sub journal_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+# FIXME: this should do something like $u->is_person to determine what kind
+# of thing to setup...
+    return 'http://www.insanejournal.com/users/' . $u->user . '/';
+}
+
+
+# argument: DW::External::User
+# returns URL to this account's journal
+sub profile_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+# FIXME: same as above
+    return 'http://www.insanejournal.com/users/' . $u->user . '/profile';
+}
+
+
+# argument: DW::External::User
+# returns URL to the badge image (head icon) for this user
+sub badge_image_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+# FIXME: same as above
+    return 'http://www.insanejournal.com/img/userinfo.gif';
+}
+
+
+1;
diff -r ce12338f02b8 -r f79dd602b888 cgi-bin/DW/External/Site/LiveJournal.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/External/Site/LiveJournal.pm	Fri Mar 06 06:53:49 2009 +0000
@@ -0,0 +1,77 @@
+#!/usr/bin/perl
+#
+# DW::External::Site::LiveJournal
+#
+# Class to support the LiveJournal.com site.
+#
+# Authors:
+#      Mark Smith <mark@dreamwidth.org>
+#
+# Copyright (c) 2009 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself.  For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::External::Site::LiveJournal;
+
+use strict;
+use base 'DW::External::Site';
+use Carp qw/ croak /;
+
+
+# new does nothing for these classes
+sub new { croak 'cannot build with new'; }
+
+
+# returns 1/0 if we allow this domain
+sub accepts {
+    my ( $class, $parts ) = @_;
+
+    # allows anything at livejournal.com
+    return 0 unless $parts->[-1] eq 'com' &&
+                    $parts->[-2] eq 'livejournal';
+
+    return bless { hostname => 'livejournal.com' }, $class;
+}
+
+
+# argument: DW::External::User
+# returns URL to this account's journal
+sub journal_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+# FIXME: this should do something like $u->is_person to determine what kind
+# of thing to setup...
+    return 'http://www.livejournal.com/users/' . $u->user . '/';
+}
+
+
+# argument: DW::External::User
+# returns URL to this account's journal
+sub profile_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+# FIXME: same as above
+    return 'http://www.livejournal.com/users/' . $u->user . '/profile';
+}
+
+
+# argument: DW::External::User
+# returns URL to the badge image (head icon) for this user
+sub badge_image_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+# FIXME: same as above
+    return "$LJ::IMGPREFIX/external/lj-userinfo.gif";
+}
+
+
+1;
diff -r ce12338f02b8 -r f79dd602b888 cgi-bin/DW/External/Site/Unknown.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/External/Site/Unknown.pm	Fri Mar 06 06:53:49 2009 +0000
@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+#
+# DW::External::Site::Unknown
+#
+# Class to try supporting some unknown site.
+#
+# Authors:
+#      Mark Smith <mark@dreamwidth.org>
+#
+# Copyright (c) 2009 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself.  For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::External::Site::Unknown;
+
+use strict;
+use base 'DW::External::Site';
+use Carp qw/ croak /;
+
+
+# new does nothing for these classes
+sub new { croak 'cannot build with new'; }
+
+
+# returns an object if we allow this domain; else undef
+sub accepts {
+    my ( $class, $parts ) = @_;
+
+    # let's just assume the last two parts are good if we have them
+    return undef unless scalar( @$parts ) >= 2;
+
+    return bless { hostname => "$parts->[-2].$parts->[-1]" }, $class;
+}
+
+
+# argument: DW::External::User
+# returns URL to this account's journal
+sub journal_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+    return 'http://www.' . $self->{hostname} . '/users/' . $u->user . '/';
+}
+
+
+# argument: DW::External::User
+# returns URL to this account's journal
+sub profile_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+    return 'http://www.' . $self->{hostname} . '/users/' . $u->user . '/profile';
+}
+
+
+# argument: DW::External::User
+# returns URL to the badge image (head icon) for this user
+sub badge_image_url {
+    my ( $self, $u ) = @_;
+    croak 'need a DW::External::User'
+        unless $u && ref $u eq 'DW::External::User';
+
+    # since we don't know what site this is, let's give them a LJ head icon...
+# FIXME: come up with an 'unknown' icon?
+    return 'http://p-stat.livejournal.com/img/userinfo.gif';
+}
+
+
+1;
diff -r ce12338f02b8 -r f79dd602b888 cgi-bin/DW/External/User.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/External/User.pm	Fri Mar 06 06:53:49 2009 +0000
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+#
+# DW::External::User
+#
+# Represents a user from an external site.  Note that we can't actually
+# do much with such users.
+#
+# Authors:
+#      Mark Smith <mark@dreamwidth.org>
+#
+# Copyright (c) 2009 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself.  For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::External::User;
+
+use strict;
+use Carp qw/ croak /;
+use DW::External::Site;
+
+
+# given a site (url) and a user (string), construct an external
+# user to return; undef on error
+sub new {
+    my ( $class, %opts ) = @_;
+
+    my $site = delete $opts{site} or return undef;
+    my $user = delete $opts{user} or return undef;
+    croak 'unknown extra options'
+        if %opts;
+
+    # site is required, or bail
+    my $ext = DW::External::Site->new( site => $site )
+        or return undef;
+
+    my $self = {
+        user => $user,
+        site => $ext,
+    };
+
+    return bless $self, $class;
+}
+
+
+# return our username
+sub user {
+    return $_[0]->{user};
+}
+
+
+# return our external site
+sub site {
+    return $_[0]->{site};
+}
+
+
+# return the ljuser_display block
+sub ljuser_display {
+    my $self = $_[0];
+
+    my $user = $self->user;
+    my $profile_url = $self->site->profile_url( $self );
+    my $journal_url = $self->site->journal_url( $self );
+    my $badge_image_url = $self->site->badge_image_url( $self );
+
+    return "<span class='ljuser' lj:user='$user' style='white-space: nowrap;'><a href='$profile_url'>" .
+           "<img src='$badge_image_url' alt='[info]' style='vertical-align: bottom; border: 0; padding-right: 1px;' />" .
+           "</a><a href='$journal_url'><b>$user</b></a></span>";
+}
+
+
+1;
diff -r ce12338f02b8 -r f79dd602b888 cgi-bin/cleanhtml.pl
--- a/cgi-bin/cleanhtml.pl	Fri Mar 06 06:16:08 2009 +0000
+++ b/cgi-bin/cleanhtml.pl	Fri Mar 06 06:53:49 2009 +0000
@@ -471,7 +471,30 @@ sub clean
                 my $user = $attr->{'user'} = exists $attr->{'user'} ? $attr->{'user'} :
                                              exists $attr->{'comm'} ? $attr->{'comm'} : undef;
 
-                if (length $user) {
+                # allow external sites
+                if ( my $site = $attr->{site} ) {
+
+                    # try to load this user@site combination
+                    if ( my $ext_u = DW::External::User->new( user => $user, site => $site ) ) {
+
+                        # looks good, render
+                        if ( $opts->{textonly} ) {
+                            # FIXME: need a textonly way of identifying users better?  "user@LJ"?
+                            $newdata .= $user;
+                        } else {
+                            $newdata .= $ext_u->ljuser_display;
+                        }
+
+                    # if we hit the else, then we know that this user doesn't appear
+                    # to be valid at the requested site
+                    } else {
+                        $newdata .= "<b>[Bad username or site: " .
+                                    LJ::ehtml( LJ::no_utf8_flag( $user ) ) . " @ " .
+                                    LJ::ehtml( LJ::no_utf8_flag( $site ) ) . "]</b>";
+                    }
+
+                # failing that, no site, use the local behavior
+                } elsif (length $user) {
                     my $orig_user = $user; # save for later, in case
                     $user = LJ::canonical_username($user);
                     if (length $user) {
diff -r ce12338f02b8 -r f79dd602b888 cgi-bin/ljlib.pl
--- a/cgi-bin/ljlib.pl	Fri Mar 06 06:16:08 2009 +0000
+++ b/cgi-bin/ljlib.pl	Fri Mar 06 06:53:49 2009 +0000
@@ -56,6 +56,7 @@ use Class::Autouse qw(
                       LJ::EventLogRecord::DeleteComment
                       );
 
+use DW::External::User;
 use DW::Logic::LogItems;
 
 # make Unicode::MapUTF8 autoload:
diff -r ce12338f02b8 -r f79dd602b888 htdocs/img/external/lj-userinfo.gif
Binary file htdocs/img/external/lj-userinfo.gif has changed
--------------------------------------------------------------------------------