cgi-bin/fbupload.pl

   1 #!/usr/bin/perl
   2
   3 package LJ::FBUpload;
   4
   5 use strict;
   6 use lib "$ENV{LJHOME}/cgi-bin";
   7 use LJ::Config;
   8
   9 LJ::Config->load;
  10
  11 use LJ;
  12
  13 use MIME::Words ();
  14 use XML::Simple;
  15 use IO::Handle;
  16 use LWP::UserAgent;
  17 use URI::Escape;
  18 use Digest::MD5 ();
  19 use File::Basename ();
  20
  21 # This has bitten us one too many times.
  22 # Don't let startup continue unless LWP is ok.
  23 die "* Installed version of LWP is too old! *" if LWP->VERSION < 5.803;
  24
  25 sub make_auth {
  26     my ($u, $chal) = @_;
  27     return unless $u->has_password && $chal;
  28     return "crp:$chal:" . Digest::MD5::md5_hex($chal . $u->password_md5);
  29 }
  30
  31 sub get_challenge {
  32     my ($u, $ua, $err) = @_;
  33     return unless $u && $ua;
  34
  35     my $req = HTTP::Request->new(GET => "$LJ::FB_SITEROOT/interface/simple");
  36     $req->push_header("X-FB-Mode" => "GetChallenge");
  37     $req->push_header("X-FB-User" => $u->{'user'});
  38
  39     my $res = $$ua->request($req);
  40     if ($res->is_success()) {
  41
  42         my $xmlres = XML::Simple::XMLin($res->content);
  43         my $methres = $xmlres->{GetChallengeResponse};
  44         return $methres->{Challenge};
  45
  46     } else {
  47         $$err = $res->content();
  48         return;
  49     }
  50 }
  51
  52 # <LJFUNC>
  53 # name: LJ::FBUpload::do_upload
  54 # des: Uploads an image to FotoBilder from LiveJournal.
  55 # args: path, rawdata?, imgsec, caption?, galname
  56 # des-path: => path to image on disk, or title to use if 'rawdata' isn't on disk.
  57 # des-rawdata: => optional image data scalar ref.
  58 # des-imgsec: => bitmask for image security. Defaults to private on
  59 #             unknown strings. Lack of an imgsec opt means public.
  60 # des-caption: => optional image description.
  61 # des-galname: => gallery to upload image to.
  62 # info:
  63 # returns: FB protocol data structure, regardless of FB success or failure.
  64 #         It's the callers responsibility to check the structure
  65 #         for FB return values.
  66 #         On HTTP failure, returns numeric HTTP error code, and
  67 #         sets $rv reference with errorstring. Or undef on unrecoverable failure.
  68 # </LJFUNC>
  69 sub do_upload {
  70     my ($u, $rv, $opts) = @_;
  71     unless ($u && $opts->{'path'}) {
  72         $$rv = "Invalid parameters to do_upload()";
  73         return;
  74     }
  75
  76     my $ua = LWP::UserAgent->new;
  77     $ua->agent("LiveJournal_FBUpload/0.2");
  78
  79     my $err;
  80     my $chal = get_challenge($u, \$ua, \$err);
  81     unless ($chal) {
  82         $$rv = "Error getting challenge from FB server: $err";
  83         return;
  84     }
  85
  86     my $rawdata = $opts->{'rawdata'};
  87     unless ($rawdata) {
  88         # no rawdata was passed, so slurp it in ourselves
  89         unless (open (F, $opts->{'path'})) {
  90             $$rv = "Couldn't read image file: $!\n";
  91             return;
  92         }
  93         binmode(F);
  94         my $data;
  95         { local $/ = undef; $data = <F>; }
  96         $rawdata = \$data;
  97         close F;
  98     }
  99
 100     # convert strings to security masks/
 101     # default to private on unknown strings.
 102     # lack of an imgsec opt means public.
 103     $opts->{imgsec} ||= 255;
 104     unless ($opts->{imgsec} =~ /^\d+$/) {
 105         my %groupmap = (
 106             private  => 0,   regusers => 253,
 107             friends  => 254, public => 255
 108         );
 109         $opts->{imgsec} = 'private' unless $groupmap{ $opts->{imgsec} };
 110         $opts->{imgsec} = $groupmap{ $opts->{imgsec} };
 111     }
 112
 113     my $basename = File::Basename::basename($opts->{'path'});
 114     my $length = length $$rawdata;
 115
 116     my $req = HTTP::Request->new(PUT => "$LJ::FB_SITEROOT/interface/simple");
 117     my %headers = (
 118         'X-FB-Mode'                    => 'UploadPic',
 119         'X-FB-UploadPic.ImageLength'   => $length,
 120         'Content-Length'               => $length,
 121         'X-FB-UploadPic.Meta.Filename' => $basename,
 122         'X-FB-UploadPic.MD5'           => Digest::MD5::md5_hex($$rawdata),
 123         'X-FB-User'                    => $u->{'user'},
 124         'X-FB-Auth'                    => make_auth($u, $chal),
 125         ':X-FB-UploadPic.Gallery._size'=> 1,
 126         'X-FB-UploadPic.PicSec'        => $opts->{'imgsec'},
 127         'X-FB-UploadPic.Gallery.0.GalName' => $opts->{'galname'} || 'LJ_emailpost',
 128         'X-FB-UploadPic.Gallery.0.GalSec'  => 255
 129     );
 130
 131     $headers{'X-FB-UploadPic.Meta.Title'} = $opts->{title}
 132       if $opts->{title};
 133
 134     $headers{'X-FB-UploadPic.Meta.Description'} = $opts->{caption}
 135       if $opts->{caption};
 136
 137     $req->push_header($_, $headers{$_}) foreach keys %headers;
 138
 139     $req->content($$rawdata);
 140     my $res = $ua->request($req);
 141
 142     my $res_code = ($res->status_line =~ /^(\d+)/) ? $1 : '';
 143     unless ($res->is_success) {
 144         $$rv = "HTTP error uploading pict: " . $res->content();
 145         return $res_code;
 146     }
 147
 148     my $xmlres;
 149     eval { $xmlres = XML::Simple::XMLin($res->content); };
 150     if ($@) {
 151         $$rv = "Error parsing XML: $@";
 152         return;
 153     }
 154     my $methres = $xmlres->{UploadPicResponse};
 155     $methres->{Title} = $basename;
 156
 157     return $methres;
 158 }
 159
 160 # args:
 161 #       $u,
 162 #       arrayref of { title, url, width, height, caption }
 163 #       optional opts overrides hashref.
 164 #               (if not supplied, userprops are used.)
 165 # returns: html string suitable for entry post body
 166 # TODO: Hook this like the Fotobilder "post to journal"
 167 #       caption posting page.  More pretty. (layout keywords?)
 168 sub make_html {
 169     my ($u, $images, $opts) = @_;
 170     my ($icount, $html);
 171
 172     $icount = scalar @$images;
 173     return "" unless $icount;
 174
 175     # Merge overrides with userprops that might
 176     # have been passed in.
 177     $opts = {} unless $opts && ref $opts;
 178     my @props = qw/ emailpost_imgsize emailpost_imglayout emailpost_imgcut /;
 179
 180     LJ::load_user_props( $u, @props );
 181
 182     foreach ( @props ) {
 183         my $prop = $_;
 184         $prop =~ s/emailpost_//;
 185         $opts->{$prop} = lc($opts->{$prop}) || $u->{$_};
 186     }
 187
 188     $html .= "\n";
 189
 190     # set journal image display size
 191     my @valid_sizes = qw/ 100x100 320x240 640x480 /;
 192     $opts->{imgsize} = '320x240' unless grep { $opts->{imgsize} eq $_; } @valid_sizes;
 193     my ($width, $height) = split 'x', $opts->{imgsize};
 194
 195     # force lj-cut on images larger than 320 in either direction
 196     $opts->{imgcut} = 'count'
 197       if ( $width > 320 || $height > 320 ) && ! $opts->{imgcut};
 198
 199     # insert image links into post body
 200     my $horiz = $opts->{imglayout} =~ /^horiz/i;
 201     $html .=
 202       "<lj-cut text='$icount "
 203       . ( ( $icount == 1 ) ? 'image' : 'images' ) . "'>"
 204           if $opts->{imgcut} eq 'count';
 205     $html .= "<table border='0'><tr>" if $horiz;
 206
 207     foreach my $i ( @$images ) {
 208         my $title = LJ::ehtml($i->{'title'});
 209
 210         my ( $image_url, $page_url, $scaled_url );
 211         $image_url = $i->{'url'};
 212
 213         my $image_uri      = URI->new($image_url);
 214         my $image_hostname = $image_uri ? $image_uri->host : '';
 215
 216         if ( $image_hostname =~ /^ic?[.]pics/ ) {
 217             my ($extension) = ( $image_url =~ /(\w+)$/ );
 218
 219             $scaled_url = $page_url = $image_url;
 220             $scaled_url =~ s/original\.\w+$//;
 221
 222             $scaled_url = $scaled_url . $width . '.' . $extension;
 223         }
 224         else {
 225             $page_url = $image_url . '/';
 226
 227             if ( $i->{'width'} > $width || $i->{'height'} > $height ) {
 228                 $scaled_url = $page_url . '/s' . $opts->{'imgsize'};
 229             }
 230             else {
 231                 $scaled_url = $image_url;
 232             }
 233         }
 234
 235         # don't set a size on images smaller than the requested width/height
 236         # (we never scale larger, just smaller)
 237         my $size = '/s' . $opts->{imgsize};
 238         undef $size if $i->{width} <= $width || $i->{height} <= $height;
 239
 240         $html .= "<td>" if $horiz;
 241         $html .= "<lj-cut text=\"$title\">" if $opts->{imgcut} eq 'titles';
 242         $html .= "<a href=\"$page_url\">";
 243         $html .= "<img src=\"$scaled_url\" alt=\"$title\" border=\"0\">";
 244         $html .= "</a><br />";
 245         $html .= "$i->{caption}<br />" if $i->{caption};
 246         $html .= $horiz ? '</td>' : '<br />';
 247         $html .= "</lj-cut> " if $opts->{imgcut} eq 'titles';
 248     }
 249
 250     $html .= "</tr></table>" if $horiz;
 251     $html .= "</lj-cut>\n" if $opts->{imgcut} eq 'count';
 252
 253     return $html;
 254 }
 255
 256 1;