root/trunk/cgi-bin/Apache/LiveJournal.pm @ 13819

Revision 13819, 58.4 KB (checked in by sup, 5 years ago)

Bugfixing: user-specified domains of users with underscore in name are not redirected to journal_base now
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1#!/usr/bin/perl
2#
3
4package Apache::LiveJournal;
5
6use strict;
7no warnings 'uninitialized';
8
9use Apache::Constants qw(:common REDIRECT HTTP_NOT_MODIFIED
10                         HTTP_MOVED_PERMANENTLY HTTP_MOVED_TEMPORARILY
11                         M_TRACE M_OPTIONS);
12use Apache::File ();
13use lib "$ENV{LJHOME}/cgi-bin";
14
15# needed to call S2::set_domain() so early:
16use LJ::S2;
17
18use Class::Autouse qw(
19                      LJ::Blob
20                      Apache::LiveJournal::Interface::Blogger
21                      Apache::LiveJournal::Interface::AtomAPI
22                      Apache::LiveJournal::Interface::S2
23                      Apache::LiveJournal::Interface::ElsewhereInfo
24                      Apache::LiveJournal::PalImg
25                      LJ::ModuleCheck
26                      LJ::AccessLogSink
27                      LJ::AccessLogRecord
28                      LJ::AccessLogSink::Database
29                      LJ::AccessLogSink::DInsertd
30                      LJ::AccessLogSink::DBIProfile
31                      );
32
33# these aren't lazily loaded in the typical call-a-package-method way,
34# but rather we just use Class::Autouse to bring them in during mod_perl
35# load.  in non-apache mode, they're loaded via LJ::ModuleCheck->have
36use Class::Autouse qw(
37                      Compress::Zlib
38                      XMLRPC::Transport::HTTP
39                      LJ::URI
40                      );
41
42BEGIN {
43    $LJ::OPTMOD_ZLIB = eval "use Compress::Zlib (); 1;";
44
45    require "ljlib.pl";
46    require "ljviews.pl";
47    require "ljprotocol.pl";
48    if (%LJ::FOTOBILDER_IP) {
49        use Apache::LiveJournal::Interface::FotoBilder;
50    }
51}
52
53my %RQ;       # per-request data
54my %USERPIC;  # conf related to userpics
55my %REDIR;
56
57# Mapping of MIME types to image types understood by the blob functions.
58my %MimeTypeMap = (
59    'image/gif' => 'gif',
60    'image/jpeg' => 'jpg',
61    'image/png' => 'png',
62);
63my %MimeTypeMapd6 = (
64    'G' => 'gif',
65    'J' => 'jpg',
66    'P' => 'png',
67);
68
69$USERPIC{'cache_dir'} = "$ENV{'LJHOME'}/htdocs/userpics";
70$USERPIC{'use_disk_cache'} = -d $USERPIC{'cache_dir'};
71$USERPIC{'symlink'} = eval { symlink('',''); 1; };
72
73# redirect data.
74foreach my $file ('redirect.dat', 'redirect-local.dat') {
75    open (REDIR, "$ENV{'LJHOME'}/cgi-bin/$file") or next;
76    while (<REDIR>) {
77        next unless (/^(\S+)\s+(\S+)/);
78        my ($src, $dest) = ($1, $2);
79        $REDIR{$src} = $dest;
80    }
81    close REDIR;
82}
83
84my @req_hosts;  # client IP, and/or all proxies, real or claimed
85
86# init handler (PostReadRequest)
87sub handler
88{
89    my $r = shift;
90
91    if ($LJ::SERVER_TOTALLY_DOWN) {
92        $r->handler("perl-script");
93        $r->set_handlers(PerlHandler => [ \&totally_down_content ]);
94        return OK;
95    }
96
97    # only perform this once in case of internal redirects
98    if ($r->is_initial_req) {
99        $r->push_handlers(PerlCleanupHandler => sub { %RQ = () });
100        $r->push_handlers(PerlCleanupHandler => "Apache::LiveJournal::db_logger");
101        $r->push_handlers(PerlCleanupHandler => "LJ::end_request");
102        $r->push_handlers(PerlCleanupHandler => "Apache::DebateSuicide");
103
104        if ($LJ::TRUST_X_HEADERS) {
105            # if we're behind a lite mod_proxy front-end, we need to trick future handlers
106            # into thinking they know the real remote IP address.  problem is, it's complicated
107            # by the fact that mod_proxy did nothing, requiring mod_proxy_add_forward, then
108            # decided to do X-Forwarded-For, then did X-Forwarded-Host, so we have to deal
109            # with all permutations of versions, hence all the ugliness:
110            @req_hosts = ($r->connection->remote_ip);
111            if (my $forward = $r->header_in('X-Forwarded-For'))
112            {
113                my (@hosts, %seen);
114                foreach (split(/\s*,\s*/, $forward)) {
115                    next if $seen{$_}++;
116                    push @hosts, $_;
117                    push @req_hosts, $_;
118                }
119                if (@hosts) {
120                    my $real = shift @hosts;
121                    $r->connection->remote_ip($real);
122                }
123                $r->header_in('X-Forwarded-For', join(", ", @hosts));
124            }
125
126            # and now, deal with getting the right Host header
127            if ($_ = $r->header_in('X-Host')) {
128                $r->header_in('Host', $_);
129            } elsif ($_ = $r->header_in('X-Forwarded-Host')) {
130                $r->header_in('Host', $_);
131            }
132        }
133
134        # reload libraries that might've changed
135        if ($LJ::IS_DEV_SERVER && !$LJ::DISABLED{'module_reload'}) {
136            my %to_reload;
137            while (my ($file, $mod) = each %LJ::LIB_MOD_TIME) {
138                my $cur_mod = (stat($file))[9];
139                next if $cur_mod == $mod;
140                $to_reload{$file} = 1;
141            }
142            my @key_del;
143            foreach (my ($key, $file) = each %INC) {
144                push @key_del, $key if $to_reload{$file};
145            }
146            delete $INC{$_} foreach @key_del;
147
148            foreach my $file (keys %to_reload) {
149                print STDERR "Reloading $file...\n";
150                my %reloaded;
151                local $SIG{__WARN__} = sub {
152                    if ($_[0] =~ m/^Subroutine (\S+) redefined at /)
153                    {
154                        warn @_ if ($reloaded{$1}++);
155                    } else {
156                        warn(@_);
157                    }
158                };
159                my $good = do $file;
160                if ($good) {
161                    $LJ::LIB_MOD_TIME{$file} = (stat($file))[9];
162                } else {
163                    die "Failed to reload module [$file] due to error: $@\n";
164                }
165            }
166        }
167
168        LJ::work_report_start();
169    }
170
171    $r->set_handlers(PerlTransHandler => [ \&trans ]);
172
173    return OK;
174}
175
176sub redir {
177    my ($r, $url, $code) = @_;
178    $r->content_type("text/html");
179    $r->header_out(Location => $url);
180
181    if ($LJ::DEBUG{'log_redirects'}) {
182        $r->log_error("redirect to $url from: " . join(", ", caller(0)));
183    }
184    return $code || REDIRECT;
185}
186
187# send the user to the URL for them to get their domain session cookie
188sub remote_domsess_bounce {
189    my $r = Apache->request;
190    return redir($r, LJ::remote_bounce_url(), HTTP_MOVED_TEMPORARILY);
191}
192
193sub totally_down_content
194{
195    my $r = shift;
196    my $uri = $r->uri;
197
198    if ($uri =~ m!^/interface/flat! || $uri =~ m!^/cgi-bin/log\.cg!) {
199        $r->content_type("text/plain");
200        $r->send_http_header();
201        $r->print("success\nFAIL\nerrmsg\n$LJ::SERVER_DOWN_MESSAGE");
202        return OK;
203    }
204
205    if ($uri =~ m!^/customview.cgi!) {
206        $r->content_type("text/html");
207        $r->send_http_header();
208        $r->print("<!-- $LJ::SERVER_DOWN_MESSAGE -->");
209        return OK;
210    }
211
212    # set to 500 so people don't cache this error message
213    my $body = "<h1>$LJ::SERVER_DOWN_SUBJECT</h1>$LJ::SERVER_DOWN_MESSAGE<!-- " . ("x" x 1024) . " -->";
214    $r->status_line("503 Server Maintenance");
215    $r->content_type("text/html");
216    $r->header_out("Content-length", length $body);
217    $r->send_http_header();
218
219    $r->print($body);
220    return OK;
221}
222
223sub blocked_bot
224{
225    my $r = shift;
226
227    $r->status_line("403 Denied");
228    $r->content_type("text/html");
229    $r->send_http_header();
230    my $subject = $LJ::BLOCKED_BOT_SUBJECT || "403 Denied";
231    my $message = $LJ::BLOCKED_BOT_MESSAGE || "You don't have permission to view this page.";
232
233    if ($LJ::BLOCKED_BOT_INFO) {
234        my $ip = LJ::get_remote_ip();
235        my $uniq = LJ::UniqCookie->current_uniq;
236        $message .= " $uniq @ $ip";
237    }
238
239    $r->print("<h1>$subject</h1>$message");
240    return OK;
241}
242
243sub trans
244{
245    my $r = shift;
246    return DECLINED if ! $r->is_main || $r->method_number == M_OPTIONS;  # don't deal with subrequests or OPTIONS
247
248    my $uri = $r->uri;
249    my $args = $r->args;
250    my $args_wq = $args ? "?$args" : "";
251    my $host = $r->header_in("Host");
252    my $hostport = ($host =~ s/:\d+$//) ? $& : "";
253
254    # disable TRACE (so scripts on non-LJ domains can't invoke
255    # a trace to get the LJ cookies in the echo)
256    return FORBIDDEN if $r->method_number == M_TRACE;
257
258    # If the configuration says to log statistics and GTop is available, mark
259    # values before the request runs so it can be turned into a delta later
260    if (my $gtop = LJ::gtop()) {
261        $r->pnotes( 'gtop_cpu' => $gtop->cpu );
262        $r->pnotes( 'gtop_mem' => $gtop->proc_mem($$) );
263    }
264
265    LJ::start_request();
266    LJ::procnotify_check();
267    S2::set_domain('LJ');
268
269    my $lang = $LJ::DEFAULT_LANG || $LJ::LANGS[0];
270    BML::set_language($lang, \&LJ::Lang::get_text);
271
272    my $is_ssl = $LJ::IS_SSL = LJ::run_hook("ssl_check", {
273        r => $r,
274    });
275
276    if ($r->is_initial_req) {
277        # delete cookies if there are any we want gone
278        if (my $cookie = $LJ::DEBUG{"delete_cookie"}) {
279            LJ::Session::set_cookie($cookie => 0, delete => 1, domain => $LJ::DOMAIN, path => "/");
280        }
281
282        # handle uniq cookies
283        if ($LJ::UNIQ_COOKIES) {
284
285            # this will ensure that we have a correct cookie value
286            # and also add it to $r->notes
287            LJ::UniqCookie->ensure_cookie_value;
288
289              # apply sysban block if applicable
290              if (LJ::UniqCookie->sysban_should_block) {
291                  $r->handler("perl-script");
292                  $r->push_handlers(PerlHandler => \&blocked_bot );
293                  return OK;
294              }
295          }
296    }
297
298    # only allow certain pages over SSL
299    if ($is_ssl) {
300        if ($uri =~ m!^/interface/!) {
301            # handled later
302        } elsif ($LJ::SSLDOCS && $uri !~ m!(\.\.|\%|\.\/)!) {
303            my $file = "$LJ::SSLDOCS/$uri";
304            unless (-e $file) {
305                # no such file.  send them to the main server if it's a GET.
306                return $r->method eq 'GET' ? redir($r, "$LJ::SITEROOT$uri$args_wq") : 404;
307            }
308            if (-d _) { $file .= "/index.bml"; }
309            $file =~ s!/{2,}!/!g;
310            $r->filename($file);
311            $LJ::IMGPREFIX = "/img";
312            $LJ::STATPREFIX = "/stc";
313            return OK;
314        } else {
315            return FORBIDDEN;
316        }
317    } elsif (LJ::run_hook("set_alternate_statimg")) {
318        # do nothing, hook did it.
319    } else {
320        $LJ::DEBUG_HOOK{'pre_restore_bak_stats'}->() if $LJ::DEBUG_HOOK{'pre_restore_bak_stats'};
321        $LJ::IMGPREFIX = $LJ::IMGPREFIX_BAK;
322        $LJ::STATPREFIX = $LJ::STATPREFIX_BAK;
323        $LJ::USERPIC_ROOT = $LJ::USERPICROOT_BAK if $LJ::USERPICROOT_BAK;
324    }
325
326    # let foo.com still work, but redirect to www.foo.com
327    if ($LJ::DOMAIN_WEB && $r->method eq "GET" &&
328        $host eq $LJ::DOMAIN && $LJ::DOMAIN_WEB ne $LJ::DOMAIN)
329    {
330        my $url = "$LJ::SITEROOT$uri";
331        $url .= "?" . $args if $args;
332        return redir($r, $url);
333    }
334
335    # check for sysbans on ip address
336    foreach my $ip (@req_hosts) {
337        if (LJ::sysban_check('ip', $ip) && index($uri, $LJ::BLOCKED_BOT_URI) != 0) {
338            $r->handler("perl-script");
339            $r->push_handlers(PerlHandler => \&blocked_bot );
340            return OK;
341        }
342    }
343    if (LJ::run_hook("forbid_request", $r) && index($uri, $LJ::BLOCKED_BOT_URI) != 0) {
344        $r->handler("perl-script");
345        $r->push_handlers(PerlHandler => \&blocked_bot );
346        return OK;
347    }
348
349    # see if we should setup a minimal scheme based on the initial part of the
350    # user-agent string; FIXME: maybe this should do more than just look at the
351    # initial letters?
352    if (my $ua = $r->header_in('User-Agent')) {
353        if (($ua =~ /^([a-z]+)/i) && $LJ::MINIMAL_USERAGENT{$1}) {
354            $r->notes('use_minimal_scheme' => 1);
355            $r->notes('bml_use_scheme' => $LJ::MINIMAL_BML_SCHEME);
356        }
357    }
358
359    # now we know that the request is going to succeed, so do some checking if they have a defined
360    # referer.  clients and such don't, so ignore them.
361    my $referer = $r->header_in("Referer");
362    if ($referer && $r->method eq 'POST' && !LJ::check_referer('', $referer)) {
363       $r->log_error("REFERER WARNING: POST to $uri from $referer");
364    }
365
366    my %GET = $r->args;
367
368    if ($LJ::IS_DEV_SERVER && $GET{'as'} =~ /^\w{1,15}$/) {
369        my $ru = LJ::load_user($GET{'as'});
370        LJ::set_remote($ru); # might be undef, to allow for "view as logged out"
371    }
372
373    # anti-squatter checking
374    if ($LJ::DEBUG{'anti_squatter'} && $r->method eq "GET") {
375        my $ref = $r->header_in("Referer");
376        if ($ref && index($ref, $LJ::SITEROOT) != 0) {
377            # FIXME: this doesn't anti-squat user domains yet
378            if ($uri !~ m!^/404!) {
379                # So hacky!  (see note below)
380                $LJ::SQUAT_URL = "http://$host$hostport$uri$args_wq";
381            } else {
382                # then Apache's 404 handler takes over and we get here
383                # FIXME: why??  why doesn't it just work to return OK
384                # the first time with the handlers pushed?  nothing
385                # else requires this chicanery!
386                $r->handler("perl-script");
387                $r->push_handlers(PerlHandler => \&anti_squatter);
388            }
389            return OK;
390        }
391    }
392
393    my $bml_handler = sub {
394        my $filename = shift;
395        $r->handler("perl-script");
396        $r->notes("bml_filename" => $filename);
397        $r->push_handlers(PerlHandler => \&Apache::BML::handler);
398        return OK;
399    };
400
401    # is this the embed module host
402    if ($LJ::EMBED_MODULE_DOMAIN && $host =~ /$LJ::EMBED_MODULE_DOMAIN$/) {
403        return $bml_handler->("$LJ::HOME/htdocs/tools/embedcontent.bml");
404    }
405
406    my $journal_view = sub {
407        my $opts = shift;
408        $opts ||= {};
409
410        my $orig_user = $opts->{'user'};
411        $opts->{'user'} = LJ::canonical_username($opts->{'user'});
412
413        my $remote = LJ::get_remote();
414        my $u = LJ::load_user($orig_user);
415
416        # do redirects:
417        # -- communities to the right place
418        # -- uppercase usernames
419        # -- users with hyphens/underscores, except users from external domains (see table 'domains')
420        if ($u && $u->is_community && $opts->{'vhost'} =~ /^(?:users||tilde)$/ ||
421            $orig_user ne lc($orig_user) ||
422            $orig_user =~ /[_-]/ && $u && $u->journal_base !~ m!^http://$host!i && $opts->{'vhost'} !~ /^other:/) {
423
424            my $newurl = $uri;
425
426            # if we came through $opts->{vhost} eq "users" path above, then
427            # the s/// below will not match and there will be a leading /,
428            # so the s/// leaves a leading slash as well so that $newurl is
429            # consistent for the concatenation before redirect
430            $newurl =~ s!^/(users/|community/|~)\Q$orig_user\E!/!;
431            $newurl = LJ::journal_base($u) . "$newurl$args_wq";
432            return redir($r, $newurl);
433        }
434
435        # check if this entry or journal contains adult content
436        if (LJ::is_enabled('content_flag')) {
437            # force remote to be checked
438            my $burl = LJ::remote_bounce_url();
439            return remote_domsess_bounce() if LJ::remote_bounce_url();
440
441            my $entry = $opts->{ljentry};
442            my $poster;
443
444            my $adult_content = "none";
445            if ($u && $entry) {
446                $adult_content = $entry->adult_content_calculated || $u->adult_content_calculated;
447                $poster = $entry->poster;
448            } elsif ($u) {
449                $adult_content = $u->adult_content_calculated;
450            }
451
452            # we should show the page (no interstitial) if:
453            # the remote user owns the journal we're viewing OR
454            # the remote user posted the entry we're viewing
455            my $should_show_page = $remote && ($remote->can_manage($u) || ($entry && $remote->equals($poster)));
456
457            my %journal_pages = (
458                friends => 1,
459                calendar => 1,
460                month => 1,
461                day => 1,
462                tag => 1,
463                entry => 1,
464                reply => 1,
465                lastn => 1,
466            );
467            my $is_journal_page = !$opts->{mode} || $journal_pages{$opts->{mode}};
468
469            if ($adult_content ne "none" && $is_journal_page && !$should_show_page) {
470                my $returl = LJ::eurl("http://$host" . $r->uri . "$args_wq");
471
472                LJ::ContentFlag->check_adult_cookie($returl, \%BMLCodeBlock::POST, "concepts");
473                LJ::ContentFlag->check_adult_cookie($returl, \%BMLCodeBlock::POST, "explicit");
474
475                my $cookie = $BML::COOKIE{LJ::ContentFlag->cookie_name($adult_content)};
476
477                # if they've confirmed that they're over 18, then they're over 14 too
478                if ($adult_content eq "concepts" && !$cookie) {
479                    $cookie = 1 if $BML::COOKIE{LJ::ContentFlag->cookie_name("explicit")};
480                }
481
482                # logged in users with defined ages are blocked from content that's above their age level
483                # logged in users without defined ages and logged out users are given confirmation pages (unless they have already confirmed)
484                if ($remote) {
485                    if (($adult_content eq "explicit" && $remote->is_minor) || ($adult_content eq "concepts" && $remote->is_child)) {
486                        $r->args("user=" . LJ::eurl($opts->{'user'}));
487                        return $bml_handler->(LJ::ContentFlag->adult_interstitial_path(type => "${adult_content}_blocked"));
488                    } elsif (!$remote->best_guess_age && !$cookie) {
489                        $r->args("ret=$returl&user=" . LJ::eurl($opts->{'user'}));
490                        return $bml_handler->(LJ::ContentFlag->adult_interstitial_path(type => $adult_content));
491                    }
492                } elsif (!$remote && !$cookie) {
493                    $r->args("ret=$returl&user=" . LJ::eurl($opts->{'user'}));
494                    return $bml_handler->(LJ::ContentFlag->adult_interstitial_path(type => $adult_content));
495                }
496            }
497        }
498
499        if ($opts->{'mode'} eq "info") {
500            my $u = LJ::load_user($opts->{user})
501                or return 404;
502            my $mode = $GET{mode} eq 'full' ? '?mode=full' : '';
503            return redir($r, $u->profile_url . $mode);
504        }
505
506        if ($opts->{'mode'} eq "profile") {
507            my $burl = LJ::remote_bounce_url();
508            return remote_domsess_bounce() if LJ::remote_bounce_url();
509
510            $r->notes("_journal" => $opts->{'user'});
511
512            # this is the notes field that all other s1/s2 pages use.
513            # so be consistent for people wanting to read it.
514            # _journal above is kinda deprecated, but we'll carry on
515            # its behavior of meaning "whatever the user typed" to be
516            # passed to the userinfo BML page, whereas this one only
517            # works if journalid exists.
518            if (my $u = LJ::load_user($opts->{user})) {
519                $r->notes("journalid" => $u->{userid});
520            }
521
522            my $file = LJ::run_hook("profile_bml_file");
523            $file ||= $LJ::PROFILE_BML_FILE || "userinfo.bml";
524            if ($args =~ /\bver=(\w+)\b/) {
525                $file = $LJ::ALT_PROFILE_BML_FILE{$1} if $LJ::ALT_PROFILE_BML_FILE{$1};
526            }
527            return $bml_handler->("$LJ::HOME/htdocs/$file");
528        }
529
530        if ($opts->{'mode'} eq "update") {
531            my $u = LJ::load_user($opts->{user})
532                or return 404;
533
534            return redir($r, "$LJ::SITEROOT/update.bml?usejournal=".$u->{'user'});
535        }
536
537        %RQ = %$opts;
538
539        if ($opts->{mode} eq "data" && $opts->{pathextra} =~ m!^/(\w+)(/.*)?!) {
540            my $remote = LJ::get_remote();
541            my $burl = LJ::remote_bounce_url();
542            return remote_domsess_bounce() if LJ::remote_bounce_url();
543
544            my ($mode, $path) = ($1, $2);
545            if ($mode eq "customview") {
546                $r->handler("perl-script");
547                $r->push_handlers(PerlHandler => \&customview_content);
548                return OK;
549            }
550            if (my $handler = LJ::run_hook("data_handler:$mode", $RQ{'user'}, $path)) {
551                $r->handler("perl-script");
552                $r->push_handlers(PerlHandler => $handler);
553                return OK;
554            }
555        }
556
557        $r->handler("perl-script");
558        $r->push_handlers(PerlHandler => \&journal_content);
559        return OK;
560    };
561
562    my $determine_view = sub {
563        my ($user, $vhost, $uuri) = @_;
564        my $mode = undef;
565        my $pe;
566        my $ljentry;
567
568        # if favicon, let filesystem handle it, for now, until
569        # we have per-user favicons.
570        return DECLINED if $uuri eq "/favicon.ico";
571
572        # see if there is a modular handler for this URI
573        my $ret = LJ::URI->handle($uuri, $r);
574        return $ret if defined $ret;
575
576        if ($uuri eq "/__setdomsess") {
577            return redir($r, LJ::Session->setdomsess_handler($r));
578        }
579
580        if ($uuri =~ m#^/(\d+)\.html$#) {
581            my $u = LJ::load_user($user)
582                or return 404;
583
584            $ljentry = LJ::Entry->new($u, ditemid => $1);
585            if ($GET{'mode'} eq "reply" || $GET{'replyto'} || $GET{'edit'}) {
586                $mode = "reply";
587            } else {
588                $mode = "entry";
589            }
590        } elsif ($uuri =~ m#^/(\d\d\d\d)(?:/(\d\d)(?:/(\d\d))?)?(/?)$#) {
591            my ($year, $mon, $day, $slash) = ($1, $2, $3, $4);
592            unless ($slash) {
593                my $u = LJ::load_user($user)
594                    or return 404;
595                my $proper = $u->journal_base . "/$year";
596                $proper .= "/$mon" if defined $mon;
597                $proper .= "/$day" if defined $day;
598                $proper .= "/";
599                return redir($r, $proper);
600            }
601
602            # the S1 ljviews code looks at $opts->{'pathextra'}, because
603            # that's how it used to do it, when the pathextra was /day[/yyyy/mm/dd]
604            $pe = $uuri;
605
606            if (defined $day) {
607                $mode = "day";
608            } elsif (defined $mon) {
609                $mode = "month";
610            } else {
611                $mode = "calendar";
612            }
613
614        } elsif ($uuri =~ m!
615                 /([a-z\_]+)?           # optional /<viewname>
616                 (.*)                   # path extra: /FriendGroup, for example
617                 !x && ($1 eq "" || defined $LJ::viewinfo{$1}))
618        {
619            ($mode, $pe) = ($1, $2);
620            $mode ||= "" unless length $pe;  # if no pathextra, then imply 'lastn'
621
622            # redirect old-style URLs to new versions:
623            if ($mode =~ /^day|calendar$/ && $pe =~ m!^/\d\d\d\d!) {
624                my $newuri = $uri;
625                $newuri =~ s!$mode/(\d\d\d\d)!$1!;
626                return redir($r, LJ::journal_base($user) . $newuri);
627            } elsif ($mode eq 'rss') {
628                # code 301: moved permanently, update your links.
629                return redir($r, LJ::journal_base($user) . "/data/rss$args_wq", 301);
630            } elsif ($mode eq 'pics' && $LJ::REDIRECT_ALLOWED{$LJ::FB_DOMAIN}) {
631                # redirect to a user's gallery
632                my $url = "$LJ::FB_SITEROOT/$user";
633                return redir($r, $url);
634            } elsif ($mode eq 'tag') {
635
636                # tailing slash on here to prevent a second redirect after this one
637                return redir($r, LJ::journal_base($user) . "$uri/") unless $pe;
638                if ($pe eq '/') {
639                    # tag list page
640                    $mode = 'tag';
641                    $pe = undef;
642                } else {
643                    # filtered lastn page
644                    $mode = 'lastn';
645
646                    # prepend /tag so that lastn knows to do tag filtering
647                    $pe = "/tag$pe";
648                }
649            } elsif ($mode eq 'security') {
650                # tailing slash on here to prevent a second redirect after this one
651                return redir($r, LJ::journal_base($user) . "$uri/") unless $pe;
652                if ($pe eq '/') {
653                    # do a 404 for now
654                    return 404;
655                } else {
656                    # filtered lastn page
657                    $mode = 'lastn';
658
659                    # prepend /security so that lastn knows to do security filtering
660                    $pe = "/security$pe";
661                }
662            }
663        } elsif (($vhost eq "users" || $vhost =~ /^other:/) &&
664                 $uuri eq "/robots.txt") {
665            $mode = "robots_txt";
666        } else {
667            my $key = $uuri;
668            $key =~ s!^/!!;
669            my $u = LJ::load_user($user)
670                or return 404;
671
672            my ($type, $nodeid) =
673                $LJ::DISABLED{'named_permalinks'} ? () :
674                $u->selectrow_array("SELECT nodetype, nodeid FROM urimap WHERE journalid=? AND uri=?",
675                                    undef, $u->{userid}, $key);
676            if ($type eq "L") {
677                $ljentry = LJ::Entry->new($u, ditemid => $nodeid);
678                if ($GET{'mode'} eq "reply" || $GET{'replyto'} || $GET{'edit'}) {
679                    $mode = "reply";
680                } else {
681                    $mode = "entry";
682                }
683            }
684
685        }
686
687        return undef unless defined $mode;
688
689        # Now that we know ourselves to be at a sensible URI, redirect renamed
690        # journals. This ensures redirects work sensibly for all valid paths
691        # under a given username, without sprinkling redirects everywhere.
692        my $u = LJ::load_user($user);
693        if ($u && $u->{'journaltype'} eq 'R' && $u->{'statusvis'} eq 'R') {
694            LJ::load_user_props($u, 'renamedto');
695            my $renamedto = $u->{'renamedto'};
696            if ($renamedto ne '') {
697                my $redirect_url = ($renamedto =~ m!^https?://!) ? $renamedto : LJ::journal_base($renamedto, $vhost) . $uuri . $args_wq;
698                return redir($r, $redirect_url, 301);
699            }
700        }
701
702        return $journal_view->({
703            'vhost' => $vhost,
704            'mode' => $mode,
705            'args' => $args,
706            'pathextra' => $pe,
707            'user' => $user,
708            'ljentry' => $ljentry,
709        });
710    };
711
712    # flag if we hit a domain that was configured as a "normal" domain
713    # which shouldn't be inspected for its domain name.  (for use with
714    # Akamai and other CDN networks...)
715    my $skip_domain_checks = 0;
716
717    # user domains
718    if (($LJ::USER_VHOSTS || $LJ::ONLY_USER_VHOSTS) &&
719        $host =~ /^([\w\-]{1,15})\.\Q$LJ::USER_DOMAIN\E$/ &&
720        $1 ne "www" &&
721
722        # 1xx: info, 2xx: success, 3xx: redirect, 4xx: client err, 5xx: server err
723        # let the main server handle any errors
724        $r->status < 400)
725    {
726        my $user = $1;
727
728        # see if the "user" is really functional code
729        my $func = $LJ::SUBDOMAIN_FUNCTION{$user};
730
731        if ($func eq "normal") {
732            # site admin wants this domain to be ignored and treated as if it
733            # were "www", so set this flag so the custom "OTHER_VHOSTS" check
734            # below fails.
735            $skip_domain_checks = 1;
736
737        } elsif ($func eq "cssproxy") {
738
739            return $bml_handler->("$LJ::HOME/htdocs/extcss/index.bml");
740
741        } elsif ($func eq 'portal') {
742            # if this is a "portal" subdomain then prepend the portal URL
743            return redir($r, "$LJ::SITEROOT/portal/");
744
745        } elsif ($func eq 'support') {
746            return redir($r, "$LJ::SITEROOT/support/");
747
748        } elsif (ref $func eq "ARRAY" && $func->[0] eq "changehost") {
749
750            return redir($r, "http://$func->[1]$uri$args_wq");
751
752        } elsif ($uri =~ m!^/(?:talkscreen|delcomment)\.bml!) {
753            # these URLs need to always work for the javascript comment management code
754            # (JavaScript can't do cross-domain XMLHttpRequest calls)
755            return DECLINED;
756
757        } elsif ($func eq "journal") {
758
759            unless ($uri =~ m!^/(\w{1,15})(/.*)?$!) {
760                return DECLINED if $uri eq "/favicon.ico";
761                my $redir = LJ::run_hook("journal_subdomain_redirect_url",
762                                         $host, $uri);
763                return redir($r, $redir) if $redir;
764                return 404;
765            }
766            ($user, $uri) = ($1, $2);
767            $uri ||= "/";
768
769            # redirect them to their canonical URL if on wrong host/prefix
770            if (my $u = LJ::load_user($user)) {
771                my $canon_url = $u->journal_base;
772                unless ($canon_url =~ m!^http://$host!i || $LJ::DEBUG{'user_vhosts_no_wronghost_redirect'}) {
773                    return redir($r, "$canon_url$uri$args_wq");
774                }
775            }
776
777            my $view = $determine_view->($user, "safevhost", $uri);
778            return $view if defined $view;
779
780        } elsif ($func) {
781            my $code = {
782                'userpics' => \&userpic_trans,
783                'files' => \&files_trans,
784            };
785            return $code->{$func}->($r) if $code->{$func};
786            return 404;  # bogus ljconfig
787        } else {
788            my $view = $determine_view->($user, "users", $uri);
789            return $view if defined $view;
790            return 404;
791        }
792    }
793
794    # custom used-specified domains
795    if ($LJ::OTHER_VHOSTS && !$skip_domain_checks &&
796        $host ne $LJ::DOMAIN_WEB &&
797        $host ne $LJ::DOMAIN && $host =~ /\./ &&
798        $host =~ /[^\d\.]/)
799    {
800        my $dbr = LJ::get_db_reader();
801        my $checkhost = lc($host);
802        $checkhost =~ s/^www\.//i;
803        $checkhost = $dbr->quote($checkhost);
804        # FIXME: memcache this?
805        my $user = $dbr->selectrow_array(qq{
806            SELECT u.user FROM useridmap u, domains d WHERE
807            u.userid=d.userid AND d.domain=$checkhost
808        });
809        return 404 unless $user;
810
811        my $view = $determine_view->($user, "other:$host$hostport", $uri);
812        return $view if defined $view;
813        return 404;
814    }
815
816    # userpic
817    return userpic_trans($r) if $uri =~ m!^/userpic/!;
818
819    # front page journal
820    if ($LJ::FRONTPAGE_JOURNAL) {
821        my $view = $determine_view->($LJ::FRONTPAGE_JOURNAL, "front", $uri);
822        return $view if defined $view;
823    }
824
825    # normal (non-domain) journal view
826    if (
827        $uri =~ m!
828        ^/(users\/|community\/|\~)  # users/community/tilde
829        ([^/]*)                     # potential username
830        (.*)?                       # rest
831        !x)
832    {
833        my ($part1, $user, $rest) = ($1, $2, $3);
834
835        # get what the username should be
836        my $cuser = LJ::canonical_username($user);
837        return DECLINED unless length($cuser);
838
839        my $srest = $rest || '/';
840
841        # need to redirect them to canonical version
842        if ($LJ::ONLY_USER_VHOSTS && ! $LJ::DEBUG{'user_vhosts_no_old_redirect'}) {
843            # FIXME: skip two redirects and send them right to __setdomsess with the right
844            #        cookie-to-be-set arguments.  below is the easy/slow route.
845            my $u = LJ::load_user($cuser)
846                or return 404;
847            my $base = $u->journal_base;
848            return redir($r, "$base$srest$args_wq", correct_url_redirect_code());
849        }
850
851        # redirect to canonical username and/or add slash if needed
852        return redir($r, "http://$host$hostport/$part1$cuser$srest$args_wq")
853            if $cuser ne $user or not $rest;
854
855        my $vhost = { 'users/' => '', 'community/' => 'community',
856                      '~' => 'tilde' }->{$part1};
857
858        my $view = $determine_view->($user, $vhost, $rest);
859        return $view if defined $view;
860    }
861
862    # custom interface handler
863    if ($uri =~ m!^/interface/([\w\-]+)$!) {
864        my $inthandle = LJ::run_hook("interface_handler", {
865            int         => $1,
866            r           => $r,
867            bml_handler => $bml_handler,
868        });
869        return $inthandle if defined $inthandle;
870    }
871
872    # protocol support
873    if ($uri =~ m!^/(?:interface/(\w+))|cgi-bin/log\.cgi!) {
874        my $int = $1 || "flat";
875        $r->handler("perl-script");
876        if ($int eq "fotobilder") {
877            return 403 unless $LJ::FOTOBILDER_IP{$r->connection->remote_ip};
878            $r->push_handlers(PerlHandler => \&Apache::LiveJournal::Interface::FotoBilder::handler);
879            return OK;
880        }
881        if ($int =~ /^flat|xmlrpc|blogger|elsewhere_info|atom(?:api)?$/) {
882            $RQ{'interface'} = $int;
883            $RQ{'is_ssl'} = $is_ssl;
884            $r->push_handlers(PerlHandler => \&interface_content);
885            return OK;
886        }
887        if ($int eq "s2") {
888            Apache::LiveJournal::Interface::S2->load;
889            $r->push_handlers(PerlHandler => \&Apache::LiveJournal::Interface::S2::handler);
890            return OK;
891        }
892        return 404;
893    }
894
895    # see if there is a modular handler for this URI
896    my $ret = LJ::URI->handle($uri, $r);
897    return $ret if defined $ret;
898
899    # customview (get an S1 journal by number)
900    if ($uri =~ m!^/customview\.cgi!) {
901        $r->handler("perl-script");
902        $r->push_handlers(PerlHandler => \&customview_content);
903        return OK;
904    }
905
906    if ($uri =~ m!^/palimg/!) {
907        Apache::LiveJournal::PalImg->load;
908        $r->handler("perl-script");
909        $r->push_handlers(PerlHandler => \&Apache::LiveJournal::PalImg::handler);
910        return OK;
911    }
912
913    # redirected resources
914    if ($REDIR{$uri}) {
915        my $new = $REDIR{$uri};
916        if ($r->args) {
917            $new .= ($new =~ /\?/ ? "&" : "?");
918            $new .= $r->args;
919        }
920        return redir($r, $new, HTTP_MOVED_PERMANENTLY);
921    }
922
923    # confirm
924    if ($uri =~ m!^/confirm/(\w+\.\w+)!) {
925        return redir($r, "$LJ::SITEROOT/register.bml?$1");
926    }
927
928    # approve
929    if ($uri =~ m!^/approve/(\w+\.\w+)!) {
930        return redir($r, "$LJ::SITEROOT/approve.bml?$1");
931    }
932
933    return FORBIDDEN if $uri =~ m!^/userpics!;
934
935    # avoid the fakeapache library having to deal with the <Files ~ *.bml> stuff
936    # in the modperl_startup.pl http_conf
937    if (ref($r) eq "Test::FakeApache::Request" && $host eq $LJ::DOMAIN_WEB) {
938        my $file = "$LJ::HTDOCS$uri";
939        $file .= "/index.bml" unless $uri =~ /\.bml$/;
940        $file =~ s!/{2,}!/!;
941        $r->notes("bml_filename" => $file);
942        return Apache::BML::handler($r);
943    }
944
945    return DECLINED;
946}
947
948sub userpic_trans
949{
950    my $r = shift;
951    return 404 unless $r->uri =~ m!^/(?:userpic/)?(\d+)/(\d+)$!;
952    my ($picid, $userid) = ($1, $2);
953
954    $r->notes("codepath" => "img.userpic");
955
956    # redirect to the correct URL if we're not at the right one,
957    # and unless CDN stuff is in effect...
958    unless ($LJ::USERPIC_ROOT ne $LJ::USERPICROOT_BAK) {
959        my $host = $r->header_in("Host");
960        unless (    $LJ::USERPIC_ROOT =~ m!^http://\Q$host\E!i
961                    || $LJ::USERPIC_ROOT_CDN && $LJ::USERPIC_ROOT_CDN =~ m!^http://\Q$host\E!i
962        ) {
963            return redir($r, "$LJ::USERPIC_ROOT/$picid/$userid");
964        }
965    }
966
967    # we can safely do this without checking since we never re-use
968    # picture IDs and don't let the contents get modified
969    return HTTP_NOT_MODIFIED if $r->header_in('If-Modified-Since');
970
971    $RQ{'picid'} = $picid;
972    $RQ{'pic-userid'} = $userid;
973
974    if ($USERPIC{'use_disk_cache'}) {
975        my @dirs_make;
976        my $file;
977
978        if ($picid =~ /^\d*(\d\d)(\d\d\d)$/) {
979            push @dirs_make, ("$USERPIC{'cache_dir'}/$2",
980                              "$USERPIC{'cache_dir'}/$2/$1");
981            $file = "$USERPIC{'cache_dir'}/$2/$1/$picid-$userid";
982        } else {
983            my $mod = sprintf("%03d", $picid % 1000);
984            push @dirs_make, "$USERPIC{'cache_dir'}/$mod";
985            $file = "$USERPIC{'cache_dir'}/$mod/p$picid-$userid";
986        }
987
988        foreach (@dirs_make) {
989            next if -d $_;
990            mkdir $_, 0777;
991        }
992
993        # set both, so we can compared later if they're the same,
994        # and thus know if directories were created (if not,
995        # apache will give us a pathinfo)
996        $RQ{'userpicfile'} = $file;
997        $r->filename($file);
998    }
999
1000    $r->handler("perl-script");
1001    $r->push_handlers(PerlHandler => \&userpic_content);
1002    return OK;
1003}
1004
1005sub userpic_content
1006{
1007    my $r = shift;
1008    my $file = $r->filename;
1009
1010    my $picid = $RQ{'picid'};
1011    my $userid = $RQ{'pic-userid'}+0;
1012
1013    # will we try to use disk cache?
1014    my $disk_cache = $USERPIC{'use_disk_cache'} &&
1015        $file eq $RQ{'userpicfile'};
1016
1017    my ($data, $lastmod);
1018    my $need_cache;
1019
1020    my $mime = "image/jpeg";
1021    my $set_mime = sub {
1022        my $data = shift;
1023        if ($data =~ /^GIF/) { $mime = "image/gif"; }
1024        elsif ($data =~ /^\x89PNG/) { $mime = "image/png"; }
1025    };
1026    my $size;
1027
1028    my $send_headers = sub {
1029        $r->content_type($mime);
1030        $r->header_out("Content-length", $size+0);
1031        $r->header_out("Cache-Control", "no-transform");
1032        $r->header_out("Last-Modified", LJ::time_to_http($lastmod));
1033        $r->send_http_header();
1034    };
1035
1036    # Load the user object and pic and make sure the picture is viewable
1037    my $u = LJ::load_userid($userid);
1038    return NOT_FOUND unless $u && $u->{'statusvis'} !~ /[XS]/;
1039
1040    my %upics;
1041    LJ::load_userpics(\%upics, [ $u, $picid ]);
1042    my $pic = $upics{$picid} or return NOT_FOUND;
1043    return NOT_FOUND if $pic->{'userid'} != $userid || $pic->{state} eq 'X';
1044
1045    # Read the mimetype from the pichash if dversion 7
1046    $mime = { 'G' => 'image/gif',
1047              'J' => 'image/jpeg',
1048              'P' => 'image/png', }->{$pic->{fmt}};
1049
1050    ### Handle reproxyable requests
1051
1052    # For dversion 7+ and mogilefs userpics, follow this path
1053    if ($pic->{location} eq 'M' ) {  # 'M' for mogilefs
1054        my $key = $u->mogfs_userpic_key( $picid );
1055
1056        if ( !$LJ::REPROXY_DISABLE{userpics} &&
1057             $r->header_in('X-Proxy-Capabilities') &&
1058             $r->header_in('X-Proxy-Capabilities') =~ m{\breproxy-file\b}i )
1059        {
1060            my $memkey = [$picid, "mogp.up.$picid"];
1061
1062            my $zone = $r->header_in('X-MogileFS-Explicit-Zone') || undef;
1063            $memkey->[1] .= ".$zone" if $zone;
1064
1065            my $cache_for = $LJ::MOGILE_PATH_CACHE_TIMEOUT || 3600;
1066
1067            my $paths = LJ::MemCache::get($memkey);
1068            unless ($paths) {
1069                my @paths = LJ::mogclient()->get_paths( $key, { noverify => 1, zone => $zone });
1070                $paths = \@paths;
1071                LJ::MemCache::add($memkey, $paths, $cache_for) if @paths;
1072            }
1073
1074            # reproxy url
1075            if ($paths->[0] =~ m/^http:/) {
1076                $r->header_out('X-REPROXY-CACHE-FOR', "$cache_for; Last-Modified Content-Type");
1077                $r->header_out('X-REPROXY-URL', join(' ', @$paths));
1078            }
1079
1080            # reproxy file
1081            else {
1082                $r->header_out('X-REPROXY-FILE', $paths->[0]);
1083            }
1084
1085            $send_headers->();
1086        }
1087
1088        else {
1089            my $data = LJ::mogclient()->get_file_data( $key );
1090            return NOT_FOUND unless $data;
1091            $size = length $$data;
1092            $send_headers->();
1093            $r->print( $$data ) unless $r->header_only;
1094        }
1095
1096        return OK;
1097    }
1098
1099    # dversion < 7 reproxy file path
1100    if ( !$LJ::REPROXY_DISABLE{userpics} &&
1101         exists $LJ::PERLBAL_ROOT{userpics} &&
1102         $r->header_in('X-Proxy-Capabilities') &&
1103         $r->header_in('X-Proxy-Capabilities') =~ m{\breproxy-file\b}i )
1104    {
1105        # Get the blobroot and load the pic hash
1106        my $root = $LJ::PERLBAL_ROOT{userpics};
1107
1108        # Now ask the blob lib for the path to send to the reproxy
1109        eval { LJ::Blob->can("autouse"); };
1110        my $fmt = ($u->{'dversion'} > 6) ? $MimeTypeMapd6{ $pic->{fmt} } : $MimeTypeMap{ $pic->{contenttype} };
1111        my $path = LJ::Blob::get_rel_path( $root, $u, "userpic", $fmt, $picid );
1112
1113        $r->header_out( 'X-REPROXY-FILE', $path );
1114        $send_headers->();
1115
1116        return OK;
1117    }
1118
1119    # try to get it from disk if in disk-cache mode
1120    if ($disk_cache) {
1121        if (-s $r->finfo) {
1122            $lastmod = (stat _)[9];
1123            $size = -s _;
1124            my $fh = Apache::File->new($file);
1125            my $magic;
1126            read($fh, $magic, 4);
1127            $set_mime->($magic);
1128            $send_headers->();
1129            $r->print($magic);
1130            $r->send_fd($fh);
1131            $fh->close();
1132            return OK;
1133        } else {
1134            $need_cache = 1;
1135        }
1136    }
1137
1138    # else, get it from db.
1139    unless ($data) {
1140        $lastmod = $pic->{'picdate'};
1141
1142        if ($LJ::USERPIC_BLOBSERVER) {
1143            eval { LJ::Blob->can("autouse"); };
1144            my $fmt = ($u->{'dversion'} > 6) ? $MimeTypeMapd6{ $pic->{fmt} } : $MimeTypeMap{ $pic->{contenttype} };
1145            $data = LJ::Blob::get($u, "userpic", $fmt, $picid);
1146        }
1147
1148        unless ($data) {
1149            my $dbb = LJ::get_cluster_reader($u);
1150            return SERVER_ERROR unless $dbb;
1151            $data = $dbb->selectrow_array("SELECT imagedata FROM userpicblob2 WHERE ".
1152                                          "userid=$pic->{'userid'} AND picid=$picid");
1153        }
1154    }
1155
1156    return NOT_FOUND unless $data;
1157
1158    if ($need_cache) {
1159        # make $realfile /userpic-userid, and $file /userpic
1160        my $realfile = $file;
1161        unless ($file =~ s/-\d+$//) {
1162            $realfile .= "-$pic->{'userid'}";
1163        }
1164
1165        # delete short file on Unix if it exists
1166        unlink $file if $USERPIC{'symlink'} && -f $file;
1167
1168        # write real file.
1169        open (F, ">$realfile"); print F $data; close F;
1170
1171        # make symlink, or duplicate file (if on Windows)
1172        my $symtarget = $realfile;  $symtarget =~ s!.+/!!;
1173        unless (eval { symlink($symtarget, $file) }) {
1174            open (F, ">$file"); print F $data; close F;
1175        }
1176    }
1177
1178    $set_mime->($data);
1179    $size = length($data);
1180    $send_headers->();
1181    $r->print($data) unless $r->header_only;
1182    return OK;
1183}
1184
1185sub files_trans
1186{
1187    my $r = shift;
1188    return 404 unless $r->uri =~ m!^/(\w{1,15})/(\w+)(/\S+)!;
1189    my ($user, $domain, $rest) = ($1, $2, $3);
1190
1191    if (my $handler = LJ::run_hook("files_handler:$domain", $user, $rest)) {
1192        $r->notes("codepath" => "files.$domain");
1193        $r->handler("perl-script");
1194        $r->push_handlers(PerlHandler => $handler);
1195        return OK;
1196    }
1197    return 404;
1198}
1199
1200sub journal_content
1201{
1202    my $r = shift;
1203    my $uri = $r->uri;
1204
1205    my %GET = $r->args;
1206
1207    if ($RQ{'mode'} eq "robots_txt")
1208    {
1209        my $u = LJ::load_user($RQ{'user'});
1210        return 404 unless $u;
1211
1212        $u->preload_props("opt_blockrobots", "adult_content", "admin_content_flag");
1213        $r->content_type("text/plain");
1214        $r->send_http_header();
1215        my @extra = LJ::run_hook("robots_txt_extra", $u), ();
1216        $r->print($_) foreach @extra;
1217        $r->print("User-Agent: *\n");
1218        if ($u->should_block_robots) {
1219            $r->print("Disallow: /\n");
1220
1221            # FOAF doesn't contain journal content
1222            $r->print("\n# If you also support the allow directive let us know\n");
1223            foreach (qw/Googlebot Slurp Teoma/) {
1224                $r->print("User-Agent: $_\n");
1225                # Some bots ignore generic section if a more specific on exists
1226                $r->print("Disallow: /\n");
1227                $r->print("Allow: /data/foaf\n");
1228                $r->print("\n");
1229            }
1230        }
1231        return OK;
1232    }
1233
1234    # handle HTTP digest authentication
1235    if ($GET{'auth'} eq 'digest' ||
1236        $r->header_in("Authorization") =~ /^Digest/) {
1237        my $res = LJ::auth_digest($r);
1238        unless ($res) {
1239            $r->content_type("text/html");
1240            $r->send_http_header();
1241            $r->print("<b>Digest authentication failed.</b>");
1242            return OK;
1243        }
1244    }
1245
1246    my $criterr = 0;
1247
1248    my $remote = LJ::get_remote({
1249        criterr      => \$criterr,
1250    });
1251
1252    return remote_domsess_bounce() if LJ::remote_bounce_url();
1253
1254    # check for faked cookies here, since this is pretty central.
1255    if ($criterr) {
1256        $r->status_line("500 Invalid Cookies");
1257        $r->content_type("text/html");
1258        # reset all cookies
1259        foreach my $dom (@LJ::COOKIE_DOMAIN_RESET) {
1260            my $cookiestr = 'ljsession=';
1261            $cookiestr .= '; expires=' . LJ::time_to_cookie(1);
1262            $cookiestr .= $dom ? "; domain=$dom" : '';
1263            $cookiestr .= '; path=/; HttpOnly';
1264            Apache->request->err_headers_out->add('Set-Cookie' => $cookiestr);
1265        }
1266
1267        $r->send_http_header();
1268        $r->print("Invalid cookies.  Try <a href='$LJ::SITEROOT/logout.bml'>logging out</a> and then logging back in.\n");
1269        $r->print("<!-- xxxxxxxxxxxxxxxxxxxxxxxx -->\n") for (0..100);
1270        return OK;
1271    }
1272
1273
1274    # LJ::make_journal() will set this flag if the user's
1275    # style system is unable to handle the requested
1276    # view (S1 can't do EntryPage or MonthPage), in which
1277    # case it's our job to invoke the legacy BML page.
1278    my $handle_with_bml = 0;
1279
1280    my %headers = ();
1281    my $opts = {
1282        'r' => $r,
1283        'headers' => \%headers,
1284        'args' => $RQ{'args'},
1285        'getargs' => \%GET,
1286        'vhost' => $RQ{'vhost'},
1287        'pathextra' => $RQ{'pathextra'},
1288        'header' => {
1289            'If-Modified-Since' => $r->header_in("If-Modified-Since"),
1290        },
1291        'handle_with_bml_ref' => \$handle_with_bml,
1292        'ljentry' => $RQ{'ljentry'},
1293    };
1294
1295    $r->notes("view" => $RQ{'mode'});
1296    my $user = $RQ{'user'};
1297    my $html = LJ::make_journal($user, $RQ{'mode'}, $remote, $opts);
1298
1299    return redir($r, $opts->{'redir'}) if $opts->{'redir'};
1300    return $opts->{'handler_return'} if defined $opts->{'handler_return'};
1301
1302    # if LJ::make_journal() indicated it can't handle the request:
1303    if ($handle_with_bml) {
1304        my $args = $r->args;
1305        my $args_wq = $args ? "?$args" : "";
1306
1307        # historical: can't show BML on user domains... redirect them.  nowadays
1308        # not a big deal, but debug option retained for other sites w/ old BML schemes
1309        if ($LJ::DEBUG{'no_bml_on_user_domains'}
1310            && $RQ{'vhost'} eq "users" && ($RQ{'mode'} eq "entry" ||
1311                                           $RQ{'mode'} eq "reply" ||
1312                                           $RQ{'mode'} eq "month"))
1313        {
1314            my $u = LJ::load_user($RQ{'user'});
1315            my $base = "$LJ::SITEROOT/users/$RQ{'user'}";
1316            $base = "$LJ::SITEROOT/community/$RQ{'user'}" if $u && $u->{'journaltype'} eq "C";
1317            return redir($r, "$base$uri$args_wq");
1318        }
1319
1320        if ($RQ{'mode'} eq "entry" || $RQ{'mode'} eq "reply") {
1321            my $filename = $RQ{'mode'} eq "entry" ?
1322                "$LJ::HOME/htdocs/talkread.bml" :
1323                "$LJ::HOME/htdocs/talkpost.bml";
1324            $r->notes("_journal" => $RQ{'user'});
1325            $r->notes("bml_filename" => $filename);
1326            return Apache::BML::handler($r);
1327        }
1328
1329        if ($RQ{'mode'} eq "month") {
1330            my $filename = "$LJ::HOME/htdocs/view/index.bml";
1331            $r->notes("_journal" => $RQ{'user'});
1332            $r->notes("bml_filename" => $filename);
1333            return Apache::BML::handler($r);
1334        }
1335    }
1336
1337    my $status = $opts->{'status'} || "200 OK";
1338    $opts->{'contenttype'} ||= $opts->{'contenttype'} = "text/html";
1339    if ($opts->{'contenttype'} =~ m!^text/! &&
1340        $LJ::UNICODE && $opts->{'contenttype'} !~ /charset=/) {
1341        $opts->{'contenttype'} .= "; charset=utf-8";
1342    }
1343
1344    # Set to 1 if the code should generate junk to help IE
1345    # display a more meaningful error message.
1346    my $generate_iejunk = 0;
1347
1348    if ($opts->{'badargs'})
1349    {
1350        # No special information to give to the user, so just let
1351        # Apache handle the 404
1352        return 404;
1353    }
1354    elsif ($opts->{'baduser'})
1355    {
1356        $status = "404 Unknown User";
1357        $html = "<h1>Unknown User</h1><p>There is no user <b>$user</b> at $LJ::SITENAME.</p>";
1358        $generate_iejunk = 1;
1359    }
1360    elsif ($opts->{'badfriendgroup'})
1361    {
1362        # give a real 404 to the journal owner
1363        if ($remote && $remote->{'user'} eq $user) {
1364            $status = "404 Friend group does not exist";
1365            $html = "<h1>Not Found</h1>" .
1366                    "<p>The friend group you are trying to access does not exist.</p>";
1367
1368        # otherwise be vague with a 403
1369        } else {
1370            # send back a 403 and don't reveal if the group existed or not
1371            $status = "403 Friend group does not exist, or is not public";
1372            $html = "<h1>Denied</h1>" .
1373                    "<p>Sorry, the friend group you are trying to access does not exist " .
1374                    "or is not public.</p>\n";
1375
1376            $html .= "<p>You're not logged in.  If you're the owner of this journal, " .
1377                     "<a href='$LJ::SITEROOT/login.bml'>log in</a> and try again.</p>\n"
1378                         unless $remote;
1379        }
1380
1381        $generate_iejunk = 1;
1382
1383    } elsif ($opts->{'suspendeduser'}) {
1384        $status = "403 User suspended";
1385        $html = "<h1>Suspended User</h1>" .
1386                "<p>The content at this URL is from a suspended user.</p>";
1387
1388        $generate_iejunk = 1;
1389    }
1390
1391    unless ($html) {
1392        $status = "500 Bad Template";
1393        $html = "<h1>Error</h1><p>User <b>$user</b> has messed up their journal template definition.</p>";
1394        $generate_iejunk = 1;
1395    }
1396
1397    $r->status_line($status);
1398    foreach my $hname (keys %headers) {
1399        if (ref($headers{$hname}) && ref($headers{$hname}) eq "ARRAY") {
1400            foreach (@{$headers{$hname}}) {
1401                $r->header_out($hname, $_);
1402            }
1403        } else {
1404            $r->header_out($hname, $headers{$hname});
1405        }
1406    }
1407
1408    $r->content_type($opts->{'contenttype'});
1409    $r->header_out("Cache-Control", "private, proxy-revalidate");
1410
1411    $html .= ("<!-- xxxxxxxxxxxxxxxxxxxxxxxxxxxx -->\n" x 100) if $generate_iejunk;
1412
1413    # Parse the page content for any temporary matches
1414    # defined in local config
1415    if (my $cb = $LJ::TEMP_PARSE_MAKE_JOURNAL) {
1416        $cb->(\$html);
1417    }
1418
1419    # add crap before </body>
1420    my $before_body_close = "";
1421    LJ::run_hooks("insert_html_before_body_close", \$before_body_close);
1422    LJ::run_hooks("insert_html_before_journalctx_body_close", \$before_body_close);
1423    {
1424        my $journalu = LJ::load_user($user);
1425        my $graphicpreviews_obj = LJ::graphicpreviews_obj();
1426        $before_body_close .= $graphicpreviews_obj->render($journalu);
1427    }
1428
1429    # Insert pagestats HTML and Javascript
1430    $before_body_close .= LJ::pagestats_obj()->render('journal');
1431
1432    $html =~ s!</body>!$before_body_close</body>! if $before_body_close;
1433
1434    my $do_gzip = $LJ::DO_GZIP && $LJ::OPTMOD_ZLIB;
1435    if ($do_gzip) {
1436        my $ctbase = $opts->{'contenttype'};
1437        $ctbase =~ s/;.*//;
1438        $do_gzip = 0 unless $LJ::GZIP_OKAY{$ctbase};
1439        $do_gzip = 0 if $r->header_in("Accept-Encoding") !~ /gzip/;
1440    }
1441    my $length = length($html);
1442    $do_gzip = 0 if $length < 500;
1443
1444    if ($do_gzip) {
1445        my $pre_len = $length;
1446        $r->notes("bytes_pregzip" => $pre_len);
1447        $html = Compress::Zlib::memGzip($html);
1448        $length = length($html);
1449        $r->header_out('Content-Encoding', 'gzip');
1450    }
1451    # Let caches know that Accept-Encoding will change content
1452    $r->header_out('Vary', 'Accept-Encoding');
1453
1454    $r->header_out("Content-length", $length);
1455    $r->send_http_header();
1456    $r->print($html) unless $r->header_only;
1457
1458    return OK;
1459}
1460
1461sub customview_content
1462{
1463    my $r = shift;
1464    my %FORM = $r->args;
1465
1466    my $charset = "utf-8";
1467
1468    if ($LJ::UNICODE && $FORM{'charset'}) {
1469        $charset = $FORM{'charset'};
1470        if ($charset ne "utf-8" && ! Unicode::MapUTF8::utf8_supported_charset($charset)) {
1471            $r->content_type("text/html");
1472            $r->send_http_header();
1473            $r->print("<b>Error:</b> requested charset not supported.");
1474            return OK;
1475        }
1476    }
1477
1478    my $ctype = "text/html";
1479    if ($FORM{'type'} eq "xml") {
1480        $ctype = "text/xml";
1481    }
1482
1483    if ($LJ::UNICODE) {
1484        $ctype .= "; charset=$charset";
1485    }
1486
1487    $r->content_type($ctype);
1488
1489    my $cur_journal = LJ::Session->domain_journal;
1490    my $user = LJ::canonical_username($FORM{'username'} || $FORM{'user'} || $cur_journal);
1491    my $styleid = $FORM{'styleid'} + 0;
1492    my $nooverride = $FORM{'nooverride'} ? 1 : 0;
1493
1494    if ($LJ::ONLY_USER_VHOSTS && $cur_journal ne $user) {
1495        my $u = LJ::load_user($user)
1496            or return 404;
1497        my $safeurl = $u->journal_base . "/data/customview?";
1498        my %get_args = %FORM;
1499        delete $get_args{'user'};
1500        delete $get_args{'username'};
1501        $safeurl .= join("&", map { LJ::eurl($_) . "=" . LJ::eurl($get_args{$_}) } keys %get_args);
1502        return redir($r, $safeurl);
1503    }
1504
1505    my $remote;
1506    if ($FORM{'checkcookies'}) {
1507        $remote = LJ::get_remote();
1508    }
1509
1510    my $data = (LJ::make_journal($user, "", $remote,
1511                 { "nocache" => $FORM{'nocache'},
1512                   "vhost" => "customview",
1513                   "nooverride" => $nooverride,
1514                   "styleid" => $styleid,
1515                   "saycharset" => $charset,
1516                   "args" => scalar $r->args,
1517                   "getargs" => \%FORM,
1518                   "r" => $r,
1519               })
1520          || "<b>[$LJ::SITENAME: Bad username, styleid, or style definition]</b>");
1521
1522    if ($FORM{'enc'} eq "js") {
1523        $data =~ s/\\/\\\\/g;
1524        $data =~ s/\"/\\\"/g;
1525        $data =~ s/\n/\\n/g;
1526        $data =~ s/\r//g;
1527        $data = "document.write(\"$data\")";
1528    }
1529
1530    if ($LJ::UNICODE && $charset ne 'utf-8') {
1531        $data = Unicode::MapUTF8::from_utf8({-string=>$data, -charset=>$charset});
1532    }
1533
1534    $r->header_out("Cache-Control", "must-revalidate");
1535    $r->header_out("Content-Length", length($data));
1536    $r->send_http_header();
1537    $r->print($data) unless $r->header_only;
1538    return OK;
1539}
1540
1541sub correct_url_redirect_code {
1542    if ($LJ::CORRECT_URL_PERM_REDIRECT) {
1543        return Apache::Constants::HTTP_MOVED_PERMANENTLY();
1544    }
1545    return Apache::Constants::REDIRECT();
1546}
1547
1548sub interface_content
1549{
1550    my $r = shift;
1551    my $args = $r->args;
1552
1553    if ($RQ{'interface'} eq "xmlrpc") {
1554        return 404 unless LJ::ModuleCheck->have('XMLRPC::Transport::HTTP');
1555        my $server = XMLRPC::Transport::HTTP::Apache
1556            -> on_action(sub { die "Access denied\n" if $_[2] =~ /:|\'/ })
1557            -> dispatch_to('LJ::XMLRPC')
1558            -> handle($r);
1559        return OK;
1560    }
1561
1562    if ($RQ{'interface'} eq "blogger") {
1563        Apache::LiveJournal::Interface::Blogger->load;
1564        return 404 unless LJ::ModuleCheck->have('XMLRPC::Transport::HTTP');
1565        my $pkg = "Apache::LiveJournal::Interface::Blogger";
1566        my $server = XMLRPC::Transport::HTTP::Apache
1567            -> on_action(sub { die "Access denied\n" if $_[2] =~ /:|\'/ })
1568            -> dispatch_with({ 'blogger' => $pkg })
1569            -> dispatch_to($pkg)
1570            -> handle($r);
1571        return OK;
1572    }
1573
1574    if ($RQ{'interface'} =~ /atom(?:api)?/) {
1575        Apache::LiveJournal::Interface::AtomAPI->load;
1576        # the interface package will set up all headers and
1577        # print everything
1578        Apache::LiveJournal::Interface::AtomAPI::handle($r);
1579        return OK;
1580    }
1581
1582    if ($RQ{'interface'} =~ /elsewhere_info/) {
1583        # the interface package will set up all headers and
1584        # print everything
1585        Apache::LiveJournal::Interface::ElsewhereInfo->handle($r);
1586        return OK;
1587    }
1588
1589    if ($RQ{'interface'} ne "flat") {
1590        $r->content_type("text/plain");
1591        $r->send_http_header;
1592        $r->print("Unknown interface.");
1593        return OK;
1594    }
1595
1596    $r->content_type("text/plain");
1597
1598    my %out = ();
1599    my %FORM = ();
1600    my $content;
1601    $r->read($content, $r->header_in("Content-Length"));
1602    LJ::decode_url_string($content, \%FORM);
1603
1604    # the protocol needs the remote IP in just one place, where tracking is done.
1605    $ENV{'_REMOTE_IP'} = $r->connection()->remote_ip();
1606    LJ::do_request(\%FORM, \%out);
1607
1608    if ($FORM{'responseenc'} eq "urlenc") {
1609        $r->send_http_header;
1610        foreach (sort keys %out) {
1611            $r->print(LJ::eurl($_) . "=" . LJ::eurl($out{$_}) . "&");
1612        }
1613        return OK;
1614    }
1615
1616    my $length = 0;
1617    foreach (sort keys %out) {
1618        $length += length($_)+1;
1619        $length += length($out{$_})+1;
1620    }
1621
1622    $r->header_out("Content-length", $length);
1623    $r->send_http_header;
1624    foreach (sort keys %out) {
1625        my $key = $_;
1626        my $val = $out{$_};
1627        $key =~ y/\r\n//d;
1628        $val =~ y/\r\n//d;
1629        $r->print($key, "\n", $val, "\n");
1630    }
1631
1632    return OK;
1633}
1634
1635sub db_logger
1636{
1637    my $r = shift;
1638    my $rl = $r->last;
1639
1640    $r->pnotes('did_lj_logging' => 1);
1641
1642    # these are common enough, it's worth doing it here, early, before
1643    # constructing the accesslogrecord.
1644    if ($LJ::DONT_LOG_IMAGES) {
1645        my $uri = $r->uri;
1646        my $ctype = $rl->content_type;
1647        $ctype =~ s/;.*//;  # strip charset
1648        return if $ctype =~ m!^image/!;
1649        return if $uri =~ m!^/(img|userpic)/!;
1650    }
1651
1652    my $rec = LJ::AccessLogRecord->new($r);
1653    my @sinks = (
1654                 LJ::AccessLogSink::Database->new,
1655                 LJ::AccessLogSink::DInsertd->new,
1656                 LJ::AccessLogSink::DBIProfile->new,
1657                 );
1658
1659    if (@LJ::EXTRA_ACCESS_LOG_SINKS) {
1660        # will convert them to objects from class/ctor-arg arrayrefs
1661        push @sinks, LJ::AccessLogSink->extra_log_sinks;
1662    }
1663
1664    foreach my $sink (@sinks) {
1665        $sink->log($rec);
1666    }
1667}
1668
1669sub anti_squatter
1670{
1671    my $r = shift;
1672    $r->push_handlers(PerlHandler => sub {
1673        my $r = shift;
1674        $r->content_type("text/html");
1675        $r->send_http_header();
1676        $r->print("<html><head><title>Dev Server Warning</title>",
1677                  "<style> body { border: 20px solid red; padding: 30px; margin: 0; font-family: sans-serif; } ",
1678                  "h1 { color: #500000; }",
1679                  "</style></head>",
1680                  "<body><h1>Warning</h1><p>This server is for development and testing only.  ",
1681                  "Accounts are subject to frequent deletion.  Don't use this machine for anything important.</p>",
1682                  "<form method='post' action='/misc/ack-devserver.bml' style='margin-top: 1em'>",
1683                  LJ::html_hidden("dest", "$LJ::SQUAT_URL"),
1684                  LJ::html_submit(undef, "Acknowledged"),
1685                  "</form></body></html>");
1686        return OK;
1687    });
1688
1689}
1690
1691package LJ::Protocol;
1692
1693sub xmlrpc_method {
1694    my $method = shift;
1695    shift;   # get rid of package name that dispatcher includes.
1696    my $req = shift;
1697
1698    if (@_) {
1699        # don't allow extra arguments
1700        die SOAP::Fault
1701            ->faultstring(LJ::Protocol::error_message(202))
1702            ->faultcode(202);
1703    }
1704    my $error = 0;
1705    if (ref $req eq "HASH") {
1706        foreach my $key ('subject', 'event') {
1707            # get rid of the UTF8 flag in scalars
1708            $req->{$key} = pack('C*', unpack('C*', $req->{$key}))
1709                if $req->{$key};
1710        }
1711    }
1712    my $res = LJ::Protocol::do_request($method, $req, \$error);
1713    if ($error) {
1714        die SOAP::Fault
1715            ->faultstring(LJ::Protocol::error_message($error))
1716            ->faultcode(substr($error, 0, 3));
1717    }
1718    return $res;
1719}
1720
1721package LJ::XMLRPC;
1722
1723use vars qw($AUTOLOAD);
1724
1725sub AUTOLOAD {
1726    my $method = $AUTOLOAD;
1727    $method =~ s/^.*:://;
1728    LJ::Protocol::xmlrpc_method($method, @_);
1729}
1730
17311;
Note: See TracBrowser for help on using the browser.