cgi-bin/ljprotocol.pl

   1 #!/usr/bin/perl
   2 #
   3
   4 use strict;
   5 no warnings 'uninitialized';
   6
   7 use LJ::Constants;
   8 use Class::Autouse qw(
   9                       LJ::Event::JournalNewEntry
  10                       LJ::Event::UserNewEntry
  11                       LJ::Entry
  12                       LJ::Poll
  13                       LJ::EventLogRecord::NewEntry
  14                       LJ::EventLogRecord::EditEntry
  15                       LJ::Config
  16                       LJ::Comment
  17                       LJ::RateLimit
  18                       LJ::EmbedModule
  19                       LJ::DelayedEntry
  20                       LJ::PushNotification
  21                       LJ::Tidy
  22                       LJ::PersistentQueue
  23                       LJ::PersonalStats::Ratings::Posts
  24                       LJ::PersonalStats::Ratings::Journals
  25                       LJ::API::RateLimiter
  26                       LJ::Pay::Repost::Offer
  27                       LJ::MemCacheProxy
  28                       LJ::Entry::Repost
  29                       );
  30
  31 use LJ::TimeUtil;
  32 use POSIX;
  33
  34 LJ::Config->load;
  35
  36
  37
  38 use lib "$ENV{LJHOME}/cgi-bin";
  39
  40 require "taglib.pl";
  41
  42 # have to do this else mailgate will croak with email posting, but only want
  43 # to do it if the site has enabled the hack
  44 require "talklib.pl" if $LJ::NEW_ENTRY_CLEANUP_HACK;
  45
  46 # when posting or editing ping hubbub
  47 require "ljfeed.pl";
  48
  49 #### New interface (meta handler) ... other handlers should call into this.
  50 package LJ::Protocol;
  51
  52 # global declaration of this text since we use it in two places
  53 our $CannotBeShown = '(cannot be shown)';
  54
  55 # error classes
  56 use constant E_TEMP => 0;
  57 use constant E_PERM => 1;
  58 # maximum items for get_friends_page function
  59 use constant FRIEND_ITEMS_LIMIT => 50;
  60
  61 my %e = (
  62      # User Errors
  63      "100" => E_PERM,
  64      "101" => E_PERM,
  65      "102" => E_PERM,
  66      "103" => E_PERM,
  67      "104" => E_TEMP,
  68      "105" => E_PERM,
  69      "150" => E_PERM,
  70      "151" => E_TEMP,
  71      "152" => E_PERM,
  72      "153" => E_PERM,
  73      "154" => E_PERM,
  74      "155" => E_TEMP,
  75      "156" => E_TEMP,
  76      "157" => E_TEMP,
  77      "158" => E_TEMP,
  78      "159" => E_PERM,
  79      "160" => E_TEMP,
  80      "161" => E_PERM,
  81
  82      # Client Errors
  83      "200" => E_PERM,
  84      "201" => E_PERM,
  85      "202" => E_PERM,
  86      "203" => E_PERM,
  87      "204" => E_PERM,
  88      "205" => E_PERM,
  89      "206" => E_PERM,
  90      "207" => E_PERM,
  91      "208" => E_PERM,
  92      "209" => E_PERM,
  93      "210" => E_PERM,
  94      "211" => E_PERM,
  95      "212" => E_PERM,
  96      "213" => E_PERM,
  97      "214" => E_PERM,
  98      "215" => E_PERM,
  99      "216" => E_PERM,
 100      "217" => E_PERM,
 101      "218" => E_PERM,
 102      "219" => E_PERM,
 103      "220" => E_PERM,
 104      "221" => E_PERM,
 105      "222" => E_PERM,
 106      "223" => E_TEMP,
 107      "224" => E_TEMP,
 108      "225" => E_TEMP,
 109      "226" => E_TEMP,
 110      "227" => E_TEMP,
 111      "228" => E_TEMP,
 112      "229" => E_TEMP,
 113
 114      # Access Errors
 115      "300" => E_TEMP,
 116      "301" => E_TEMP,
 117      "302" => E_TEMP,
 118      "303" => E_TEMP,
 119      "304" => E_TEMP,
 120      "305" => E_TEMP,
 121      "306" => E_TEMP,
 122      "307" => E_PERM,
 123      "308" => E_TEMP,
 124      "309" => E_PERM,
 125      "310" => E_TEMP,
 126      "311" => E_TEMP,
 127      "312" => E_TEMP,
 128      "313" => E_TEMP,
 129      "314" => E_PERM,
 130      "315" => E_PERM,
 131      "316" => E_TEMP,
 132      "317" => E_TEMP,
 133      "318" => E_TEMP,
 134      "319" => E_TEMP,
 135      "320" => E_TEMP,
 136      "321" => E_TEMP,
 137      "322" => E_PERM,
 138      "323" => E_PERM,
 139      "324" => E_PERM,
 140      "325" => E_PERM,
 141      "326" => E_PERM,
 142      "327" => E_PERM,
 143      "328" => E_PERM,
 144      "329" => E_PERM,
 145      "330" => E_PERM,
 146      "331" => E_TEMP,
 147      "332" => E_TEMP,
 148      "333" => E_PERM,
 149      "334" => E_PERM,
 150      "335" => E_PERM,
 151      "336" => E_TEMP,
 152      "337" => E_TEMP,
 153
 154      # Limit errors
 155      "402" => E_TEMP,
 156      "404" => E_TEMP,
 157      "405" => E_TEMP,
 158      "406" => E_TEMP,
 159      "407" => E_TEMP,
 160      "408" => E_TEMP,
 161      "409" => E_PERM,
 162      "410" => E_PERM,
 163      "411" => E_TEMP,
 164      "412" => E_TEMP,
 165      "413" => E_TEMP,
 166
 167      # Server Errors
 168      "500" => E_TEMP,
 169      "501" => E_TEMP,
 170      "502" => E_TEMP,
 171      "503" => E_TEMP,
 172      "504" => E_PERM,
 173      "505" => E_TEMP,
 174      "506" => E_TEMP,
 175      "507" => E_PERM,
 176      "508" => E_PERM,
 177 );
 178
 179 my %HANDLERS = (
 180     login             => \&login,
 181     getfriendgroups   => \&getfriendgroups,
 182     getfriends        => \&getfriends,
 183     friendof          => \&friendof,
 184     checkfriends      => \&checkfriends,
 185     getdaycounts      => \&getdaycounts,
 186     postevent         => \&postevent,
 187     editevent         => \&editevent,
 188     syncitems         => \&syncitems,
 189     getevents         => \&getevents,
 190     createrepost      => \&createrepost,
 191     deleterepost      => \&deleterepost,
 192     getrepoststatus   => \&getrepoststatus,
 193     editfriends       => \&editfriends,
 194     editfriendgroups  => \&editfriendgroups,
 195     consolecommand    => \&consolecommand,
 196     getchallenge      => \&getchallenge,
 197     sessiongenerate   => \&sessiongenerate,
 198     sessionexpire     => \&sessionexpire,
 199     getusertags       => \&getusertags,
 200     getfriendspage    => \&getfriendspage,
 201     getinbox          => \&getinbox,
 202     sendmessage       => \&sendmessage,
 203     setmessageread    => \&setmessageread,
 204     addcomment        => \&addcomment,
 205     checksession      => \&checksession,
 206
 207     getrecentcomments => \&getrecentcomments,
 208     getcomments       => \&getcomments,
 209     deletecomments    => \&deletecomments,
 210     updatecomments    => \&updatecomments,
 211     editcomment       => \&editcomment,
 212
 213     getuserpics       => \&getuserpics,
 214     createpoll        => \&createpoll,
 215     getpoll           => \&getpoll,
 216     editpoll          => \&editpoll,
 217     votepoll          => \&votepoll,
 218     registerpush      => \&registerpush,
 219     unregisterpush    => \&unregisterpush,
 220     pushsubscriptions => \&pushsubscriptions,
 221     resetpushcounter  => \&resetpushcounter,
 222     getpushlist       => \&getpushlist,
 223
 224     !$LJ::DISABLED{'xmlrpc_ratings'} ? (geteventsrating => \&geteventsrating) : (),
 225     !$LJ::DISABLED{'xmlrpc_ratings'} ? (getusersrating => \&getusersrating) : (),
 226 );
 227
 228 sub translate
 229 {
 230     my ($u, $msg, $vars) = @_;
 231
 232     LJ::load_user_props($u, "browselang") unless $u->{'browselang'};
 233     return LJ::Lang::get_text($u->{'browselang'}, "protocol.$msg", undef, $vars);
 234 }
 235
 236 sub error_class
 237 {
 238     my $code = shift;
 239     $code = $1 if $code =~ /^(\d\d\d):(.+)/;
 240     return $e{$code};
 241 }
 242
 243 sub error_is_transient
 244 {
 245     my $class = error_class($_[0]);
 246     return defined $class ? ! $class+0 : undef;
 247 }
 248
 249 sub error_is_permanent
 250 {
 251     return error_class($_[0]);
 252 }
 253
 254 sub error_message
 255 {
 256     my $code = shift;
 257     my $des;
 258     ($code, $des) = ($1, $2) if $code =~ /^(\d\d\d):(.+)/;
 259
 260     my $prefix = "";
 261     my $error = LJ::Lang::ml("xmlrpc.error.$code") || LJ::Lang::get_text(undef, "xmlrpc.error.$code") || "BUG: Unknown error code ($code)!";
 262     $prefix = LJ::Lang::ml('xmlrpc.client_error') if $code >= 200;
 263     $prefix = LJ::Lang::ml('xmlrpc.server_error') if $code >= 500;
 264     my $totalerror = "$prefix$error";
 265     $totalerror .= ": $des" if $des;
 266     return $totalerror;
 267 }
 268
 269 sub do_request
 270 {
 271     # get the request and response hash refs
 272     my ($method, $req, $err, $flags) = @_;
 273
 274     if (ref $req eq "HASH") {
 275
 276         # if version isn't specified explicitly, it's version 0
 277         $req->{'ver'} ||= $req->{'version'};
 278         $req->{'ver'} = 0 unless defined $req->{'ver'};
 279
 280         # check specified language
 281         if ($req->{'lang'} && not grep /^$req->{'lang'}$/, (@LJ::LANGS, 'en')) {
 282             return fail($err, 221, $req->{'lang'} );
 283         }
 284     }
 285
 286     # set specified or default language
 287     my $current_lang = LJ::Lang::current_language();
 288     my $lang = $req->{'lang'} || $current_lang || $LJ::DEFAULT_LANG;
 289     $lang = 'en_LJ' if $lang eq 'en';
 290     LJ::Lang::current_language($lang) unless $lang eq $current_lang;
 291
 292     $flags ||= {};
 293     my @args = ($req, $err, $flags);
 294
 295     LJ::Request->notes("codepath" => "protocol.$method")
 296         if LJ::Request->is_inited && ! LJ::Request->notes("codepath");
 297
 298     my $method_ref = $HANDLERS{$method};
 299
 300     if ($method_ref)
 301     {
 302         my $result = $method_ref->(@args);
 303
 304         if ($result && exists $result->{xc3})
 305         {
 306             my $xc3 = delete $result->{xc3};
 307
 308             if ($req->{props}->{interface} eq 'xml-rpc')
 309             {
 310                 my $ua = eval { LJ::Request->header_in("User-Agent") };
 311                 Encode::from_to($ua, 'utf8', 'utf8') if $ua;
 312
 313                 my ($ip_class, $country) = LJ::GeoLocation->ip_class();
 314
 315                 my $args = {
 316                     function => $method || ''
 317                 };
 318
 319                 if ($xc3->{u})
 320                 {
 321                     my $u = $xc3->{u};
 322                     $args->{userid} = $u->userid;
 323                     $args->{usercaps} = $u->caps;
 324                 }
 325
 326                 $args->{useragent} = $ua if $ua;
 327                 $args->{country}   = $country if $country;
 328                 $args->{post}      = $xc3->{post} if $xc3->{post};
 329                 $args->{comment}   = $xc3->{comment} if $xc3->{comment};
 330
 331                 LJ::run_hooks("remote_procedure_call", $args);
 332             }
 333         }
 334
 335         return $result;
 336     }
 337
 338     LJ::Request->notes("codepath" => "") if LJ::Request->is_inited;
 339
 340     return fail($err, 201);
 341 }
 342
 343 sub getpoll
 344 {
 345     my ($req, $err, $flags) = @_;
 346     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getpoll');
 347     my $u = $flags->{'u'};
 348
 349     # check arguments
 350     my $mode = $req->{mode} || 'all';
 351     return fail($err, 203, 'mode') unless($mode =~ /enter|results|answers|all/);
 352
 353     my $pollid = $req->{pollid} + 0;
 354     return fail($err, 200, 'pollid') unless($pollid);
 355
 356     # load poll object
 357     my $poll = LJ::Poll->new($pollid);
 358     return fail($err, 203, 'pollid') unless($poll && $poll->valid);
 359
 360     # question id
 361     my $pollqid = $req->{'pollqid'} + 0;
 362
 363     my $res = {
 364         xc3 => {
 365             u => $u,
 366         },
 367         pollid => $pollid,
 368         ditemid => $poll->ditemid,
 369         name => $poll->name,
 370         whovote => $poll->whovote,
 371         whoview => $poll->whoview,
 372         posterid => $poll->posterid,
 373         journalid => $poll->journalid,
 374         journal => $poll->journal->username,
 375         poster => $poll->poster->username,
 376         status => ($poll->is_closed ? 'close' : 'open'),
 377         can_vote => $poll->can_vote($u),
 378         can_view => $poll->can_view($u),
 379         is_owner => $poll->is_owner($u),
 380         mode => $mode,
 381     };
 382
 383     my $time = $poll->get_time_user_submitted($u);
 384     $res->{submitted_time} = $time if ($time);
 385     $res->{pollqid} = $pollqid if($pollqid);
 386
 387     # Get all questions
 388     my @questions = $poll->questions;
 389
 390     @questions = grep { $_->pollqid eq $pollqid } @questions if ($pollqid);
 391     return fail($err, 203, 'pollqid') unless(@questions);
 392
 393     if ($req->{'asxml'}) {
 394         my $tidy = LJ::Tidy->new();
 395
 396         foreach my $question (@questions) {
 397             if ($question->{text}) {
 398                 $question->{text} = $tidy->clean( $question->{text} );
 399             }
 400         }
 401         $res->{'name'} = $tidy->clean( $res->{'name'} );
 402     }
 403
 404
 405     # mode to show poll questions
 406     if($mode =~ /enter|all/) {
 407         # render_enter
 408         @{$res->{questions}} = map { $_->get_hash } @questions;
 409     }
 410
 411     if($mode =~ /results|all/) {
 412         $poll->load_aggregated_results();
 413         $res->{results} = $poll->{results};
 414     }
 415
 416     if($mode =~ /answers|all/ && $poll->can_view($u)) {
 417         foreach my $question (@questions) {
 418             my @answers = map {     my $user = LJ::load_userid($_->{userid});
 419                                     if ($user) {
 420                                         $_->{'username'} = $user->username;
 421                                         if ($user->identity) {
 422                                             my $i = $user->identity;
 423                                             $_->{'identity_type'}    = $i->pretty_type;
 424                                             $_->{'identity_value'}   = $i->value;
 425                                             $_->{'identity_url'}     = $i->url($user);
 426                                             $_->{'identity_display'} = $user->display_name;
 427                                         }
 428                                     }
 429                                     $_;
 430                                 } map { delete $_->{pollqid}; $_ } $question->answers;
 431
 432             @{$res->{answers}{$question->pollqid}} = @answers;
 433         }
 434     }
 435
 436
 437     return $res;
 438 }
 439
 440 sub editpoll
 441 {
 442     my ($req, $err, $flags) = @_;
 443     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'editpoll');
 444     my $u = $flags->{'u'};
 445
 446     # check arguments
 447     my $pollid = $req->{pollid} + 0;
 448     return fail($err, 200, 'pollid') unless($pollid);
 449
 450     # load poll object
 451     my $poll = LJ::Poll->new($pollid);
 452     return fail($err, 203, 'pollid') unless($poll && $poll->valid);
 453
 454     my $is_super = $poll->prop('supermaintainer');
 455
 456     return fail($err, 103, 'xmlrpc.des.maintainer_poll') if($is_super);
 457
 458     my $status = $req->{status};
 459     return fail($err, 200, 'status') unless($status);
 460     return fail($err, 203, 'status') unless($status =~ /open|close/);
 461
 462     return fail($err, 103, 'xmlrpc.des.not_poll_owner') unless($poll->is_owner($u));
 463
 464     if($status eq 'open') {
 465         $poll->open_poll();
 466     } elsif ($status eq 'close')  {
 467         $poll->close_poll();
 468     }
 469
 470     return {
 471         pollid => $pollid,
 472         status  => ($poll->{status} eq 'X' ? 'close' : 'open') ,
 473         xc3 => {
 474             u => $u,
 475         }
 476     };
 477 }
 478
 479 sub votepoll
 480 {
 481     my ($req, $err, $flags) = @_;
 482     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'votepoll');
 483     my $u = $flags->{'u'};  # remote_id
 484
 485     # check pollid
 486     my $pollid = $req->{pollid} + 0;
 487     return fail($err, 200, 'pollid') unless($pollid);
 488
 489     # load poll object
 490     my $poll = LJ::Poll->new($pollid);
 491     return fail($err, 203, 'pollid') unless($poll && $poll->valid);
 492
 493     # check answers parameter
 494     my $answers = $req->{answers};
 495     return fail($err, 200, 'answers') unless($answers);
 496     return fail($err, 203, 'answers') unless(ref $answers eq 'HASH');
 497
 498     my @warnings;
 499     my $errors;
 500
 501     unless (LJ::Poll->process_vote($u, $pollid, $answers, \$errors, \@warnings, wrong_value_as_error => 1)) {
 502         return fail($err, 103, $errors);
 503     }
 504
 505     return {
 506         pollid  => $pollid,
 507         journalid => $poll->journalid,
 508         posterid => $poll->posterid,
 509         journal => $poll->journal->username,
 510         poster => $poll->poster->username,
 511         xc3 => {
 512             u => $u,
 513         }
 514     };
 515 }
 516
 517 sub checksession {
 518     my ($req, $err, $flags) = @_;
 519     return undef
 520         unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'checksession');
 521
 522     my $u = $flags->{'u'};
 523
 524     my $session = $u->session;
 525
 526     return {
 527         username    => $u->username,
 528         session     => $u->id.":".$session->id.":".$session->auth,
 529         caps        => $u->caps,
 530         usejournals => list_usejournals($u),
 531         xc3 => {
 532             u => $u
 533         }
 534     }
 535 }
 536
 537 sub addcomment
 538 {
 539     my ($req, $err, $flags) = @_;
 540
 541     $flags->{allow_anonymous} = 1;
 542     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'addcomment');
 543     my $u = $flags->{'u'};
 544
 545     return fail($err,200,"body") unless($req->{body});
 546     return fail($err,200,"ditemid") unless($req->{ditemid});
 547     return fail($err,200,"journal/journalid") unless($u || $req->{journal} || $req->{journalid});
 548
 549     my $journal;
 550     if ($req->{journal}) {
 551         return fail($err,100) unless LJ::canonical_username($req->{journal});
 552         $journal = LJ::load_user($req->{journal}) or return fail($err, 100);
 553         return fail($err,226)
 554             if LJ::Talk::Post::require_captcha_test($u, $journal, $req->{body}, $req->{ditemid});
 555     } elsif ( $req->{journalid} ) {
 556         $journal = LJ::load_userid($req->{journalid}) or return fail($err, 100);
 557         return fail($err,226)
 558             if LJ::Talk::Post::require_captcha_test($u, $journal, $req->{body}, $req->{ditemid});
 559     } else {
 560         $journal = $u;
 561     }
 562
 563     # some additional checks
 564     return fail($err,214) if LJ::Comment->is_text_spam( \ $req->{body} );
 565
 566     my $pk = $req->{prop_picture_keyword} || $req->{picture_keyword};
 567
 568     # create
 569     my $comment;
 570     eval {
 571         $comment = LJ::Comment->create(
 572                                        journal      => $journal,
 573                                        ditemid      => $req->{ditemid},
 574                                        parenttalkid => ($req->{parenttalkid} || int($req->{parent} / 256)),
 575
 576                                        poster       => $u,   # TODO: to allow poster to be undef
 577
 578                                        body         => $req->{body},
 579                                        subject      => $req->{subject},
 580
 581                                        props        => { picture_keyword => $pk }
 582         );
 583     };
 584
 585     return fail($err,337) unless $comment;
 586
 587     ## Counter "new_comment" for monitoring
 588     LJ::run_hook ("update_counter", {
 589         counter => "new_comment",
 590     });
 591
 592     # OK
 593     return {
 594         status      => "OK",
 595         commentlink => $comment->url,
 596         dtalkid     => $comment->dtalkid,
 597         xc3 => {
 598             u => $u,
 599             comment => {
 600                 toplevel => ($comment->parenttalkid == 0 ? 1 : 0),
 601             }
 602         }
 603     };
 604 }
 605
 606 sub getcomments {
 607     my ($req, $err, $flags) = @_;
 608
 609     $flags->{allow_anonymous} = 1;
 610
 611     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getcomments');
 612     my $u = $flags->{'u'};
 613
 614     my $journal;
 615     if($req->{journal}) {
 616         return fail($err,100) unless LJ::canonical_username($req->{journal});
 617         $journal = LJ::load_user($req->{journal}) or return fail($err, 100);
 618     } elsif ( $req->{journalid} ) {
 619         $journal = LJ::load_userid($req->{journalid}) or return fail($err, 100);
 620     } else {
 621         $journal = $u;
 622     }
 623
 624     return fail($err,200,"journal") unless($journal);
 625     return fail($err,200,'xmlrpc.des.or', {'first'=>'ditemid', 'second'=>'itemid'}) unless($req->{ditemid} || $req->{itemid});
 626
 627     my $itemid = int($req->{ditemid} / 256);
 628     $itemid ||= $req->{itemid} + 0;
 629
 630     # load root post
 631     my $jitem = LJ::Talk::get_journal_item($journal, $itemid);
 632     return fail($err,203,'xmlrpc.des.no_post_by_param', {'param'=>'ditemid'}) unless($jitem);
 633     my $up = LJ::load_userid( $jitem->{'posterid'} );
 634
 635     # check permission to access root post
 636     return fail($err,300) unless( LJ::can_view($u, $jitem));
 637
 638     my $talkid = int(($req->{dtalkid} + 0)/256);   # talkid to load thread
 639
 640     my $page_size = $req->{page_size} + 0;
 641     $page_size = 500 if($page_size <= 0 || $page_size > 500);
 642
 643     my $page = $req->{page} + 0;                # page to show  - defaut
 644     my $view = $req->{view_ditemid} + 0;        # ditemid   - external comment id to show that page with it
 645
 646     my $skip = $req->{skip} + 0;
 647     my $itemshow = $req->{itemshow} + 0;
 648
 649     my $expand = $req->{expand_strategy} ? $req->{expand_strategy} : 'default' ;
 650     return fail($err, 203, 'expand_strategy') unless ($expand =~ /^mobile|mobile_thread|expand_all|by_level|detailed|default$/);
 651
 652     my $format = $req->{format} || 'thread'; # default value thread
 653     return fail($err, 203, 'format') unless($format =~ /^thread|list$/ );
 654
 655     my $expand_all = 0;
 656     if( $expand eq 'mobile_thread' || $expand eq 'expand_all'){
 657         undef $expand;
 658         $expand_all = 1;
 659     }
 660
 661     my $expand_child;
 662     my $expand_level;
 663     if ($expand eq 'mobile') {
 664         $expand_child = $req->{expand_child} + 0;
 665         $expand_child = 3 if $expand_child > 500 || $expand_child <= 0
 666     } elsif ($expand eq 'by_level') {
 667         $expand_level = ($req->{expand_level} ? $req->{expand_level} + 0 : 1);
 668         $expand_level = 1 if $expand_level > 128 || $expand_level < 0;
 669     }
 670
 671     my $opts = {
 672         page            => $page,               # page to get
 673         view            => $view,
 674         expand_level    => $expand_level+1,
 675         expand_child    => $expand_child,
 676         expand_all      => $expand_all,
 677         init_comobj     => 0,                   # do not init LJ::Comment objects in the function
 678         up              => $up,                 # author of root post
 679         page_size       => $page_size,          # max comments returned per call!
 680         strict_page_size => 1,                  # fix page size, do not extent it in case of less comments
 681     };
 682
 683     # optional parameters
 684     $opts->{thread} = $talkid if $talkid;
 685     $opts->{expand_strategy} = $expand unless($expand eq 'default');
 686
 687     my @com = LJ::Talk::load_comments($journal, $u, "L", $itemid, $opts);
 688
 689     my %extra;
 690     $extra{topitems} = $opts->{out_items};
 691     $extra{topitem_first} = $opts->{out_itemfirst};
 692     $extra{topitem_last} = $opts->{out_itemlast};
 693     $extra{page_size} = $opts->{out_pagesize};
 694     $extra{pages} = $opts->{out_pages};
 695     $extra{page} = $opts->{out_page};
 696
 697     my @comments;
 698     my @parent = ( \{ level => -1, children => \@comments } );
 699
 700     while (my $item = shift @com){
 701         $item->{indent} ||= 0;
 702         shift( @parent ) while $item->{indent} <= ${$parent[0]}->{level};
 703
 704         my $item_data = {
 705             parentdtalkid   => $item->{parenttalkid}?($item->{parenttalkid} * 256 + $jitem->{anum}):0,
 706             postername      => $item->{userpost},
 707             level           => $item->{indent},
 708             posterid        => $item->{posterid},
 709             datepostunix    => $item->{datepost_unix},
 710             datepost        => $item->{datepost},
 711             dtalkid         => $item->{talkid} * 256 + $jitem->{anum},
 712             state           => $item->{state},
 713             is_show         => $item->{_show},
 714             is_loaded       => ($item->{_loaded} ? 1 : 0),
 715         };
 716
 717         unless($u || $item->{_show}) {
 718             delete $item_data->{postername};
 719             delete $item_data->{posterid};
 720             delete $item_data->{datepost_unix};
 721             delete $item_data->{datepost};
 722         }
 723
 724         $item_data->{body} = $item->{body} if($item->{body} && $item->{_loaded});
 725         if ($req->{'asxml'}) {
 726             my $tidy = LJ::Tidy->new();
 727             $item_data->{body} = $tidy->clean( $item_data->{body} );
 728         }
 729
 730         # add parameters to lj-embed
 731         #LJ::EmbedModule->expand_entry($item->{upost}, \$item_data->{body}, get_video_id => 1) if($item->{upost} && $req->{get_video_ids});
 732
 733         $item_data->{subject} = $item->{subject} if($item->{subject} && $item->{_loaded});
 734
 735         if($item->{upost} && $item->{upost}->identity ){
 736             my $i = $item->{upost}->identity;
 737             $item_data->{'identity_type'} = $i->pretty_type;
 738             $item_data->{'identity_value'} = $i->value;
 739             $item_data->{'identity_url'} = $i->url($item->{upost});
 740             $item_data->{'identity_display'} = $item->{upost}->display_name;
 741         }
 742
 743         if ($item->{'_loaded'} && $req->{extra}) {
 744             my $comment = LJ::Comment->new($journal, dtalkid => $item_data->{dtalkid});
 745
 746             my $userpic = $comment->userpic;
 747             $item_data->{userpic} = $userpic && $userpic->url;          # left here forawhile
 748             $item_data->{poster_userpic_url} = $item_data->{userpic};
 749
 750             $item_data->{props} = { map {$item->{props}->{$_} ? ($_ => $item->{props}->{$_}) : ()}
 751                      qw(edit_time deleted_poster picture_keyword opt_preformatted) };
 752
 753             $item_data->{props}->{'poster_ip'} = $item->{'props'}->{'poster_ip'}
 754                 if $item->{'props'}->{'poster_ip'} && $u && ( $u->{'user'} eq $up->{'user'} || $u->can_manage($journal) );
 755
 756             $item_data->{privileges} = {};
 757             $item_data->{privileges}->{'delete'}   = LJ::Talk::can_delete($u, $journal, $up, $item->{userpost});
 758             $item_data->{privileges}->{'edit'}     = $comment->user_can_edit($u);
 759             $item_data->{privileges}->{'freeze'}   = (!$comment->is_frozen && LJ::Talk::can_freeze($u, $journal, $up, $item->{userpost}));
 760             $item_data->{privileges}->{'unfreeze'} = ($comment->is_frozen && LJ::Talk::can_unfreeze($u, $journal, $up, $item->{userpost}));
 761             my $pu = $comment->poster;
 762             unless ($pu && $pu->is_suspended){
 763                 $item_data->{privileges}->{'screen'}   = (!$comment->is_screened && LJ::Talk::can_screen($u, $journal, $up, $item->{userpost}));
 764                 $item_data->{privileges}->{'unscreen'} = ($comment->is_screened && LJ::Talk::can_unscreen($u, $journal, $up, $item->{userpost}));
 765             }
 766             $item_data->{privileges}->{'spam'} = (!$comment->is_spam && LJ::Talk::can_marked_as_spam($u, $journal, $up, $item->{userpost}));
 767             $item_data->{privileges}->{'unspam'} = ($comment->is_spam && LJ::Talk::can_unmark_spam($u, $journal, $up, $item->{userpost}));
 768             $item_data->{privileges}->{'reply'} = (LJ::Talk::Post::require_captcha_test($u, $journal, '', $req->{ditemid}) ? 0 : 1);
 769         }
 770
 771         if ( $req->{calculate_count} ){
 772             $item_data->{thread_count} = 0;
 773             $$_->{thread_count}++ for @parent;
 774         }
 775
 776         if( $req->{only_loaded} && !$item->{_loaded} ){
 777             my $hc = \${$parent[0]}->{has_children};
 778             $$hc = $$hc?$$hc+1:1;
 779             next unless $req->{calculate_count};
 780         }elsif( $format eq 'list' ){ # list or thread
 781             push @comments, $item_data;
 782         }else{
 783             ${$parent[0]}->{children} = [] unless ${$parent[0]}->{children};
 784             push @{${$parent[0]}->{children}}, $item_data;
 785         }
 786
 787         my $children = $item->{children};
 788         if($children && @$children){
 789             $_->{indent} = $item->{indent} + 1 for @$children;
 790             unshift @com, @$children;
 791             unshift @parent, \$item_data;
 792             undef $item->{children};
 793         }
 794     }
 795
 796     if($format eq 'list') {
 797         $extra{items} = scalar(@comments);
 798         $itemshow = $extra{items} unless ($itemshow && $itemshow <= $extra{items});
 799         @comments = splice(@comments, $skip, $itemshow);
 800         $extra{skip} = $skip;
 801         $extra{itemshow} = $itemshow;
 802     }
 803
 804     return {
 805         comments => \@comments,
 806         %extra,
 807         xc3 => {
 808             u => $flags->{'u'}
 809         }
 810     };
 811 }
 812
 813 =head deletecomments
 814     Delete specified comment, comments or thread(s) of comments in specified journal that current use
 815     Parameters:
 816         journal/journalid or current user's journal
 817         dtalkid/dtalkids - ids of current
 818         thread  - bool
 819
 820 =cut
 821 sub deletecomments {
 822     my ($req, $err, $flags) = @_;
 823     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'deletecomments');
 824
 825     my $u = $flags->{'u'};
 826     my $journal;
 827     if($req->{journal}) {
 828         return fail($err,100) unless LJ::canonical_username($req->{journal});
 829         $journal = LJ::load_user($req->{journal}) or return fail($err, 100);
 830     } elsif($req->{journalid}) {
 831         $journal = LJ::load_userid($req->{journalid}) or return fail($err, 100);
 832     } else {
 833         $journal = $u;
 834     }
 835
 836     return fail($err, 200, 'xmlrpc.des.or', {'first'=>'dtalkid','second'=>'dtalkids'}) unless($req->{dtalkid} || $req->{dtalkids});
 837     my @ids;
 838     if ($req->{dtalkids}) {
 839         foreach my $num (split(/\s*,\s*/, $req->{'dtalkids'})) {
 840             return fail($err, 203, 'xmlrpc.des.non_arifmetic', {'param'=>'dtalkid','value'=>$num}) unless $num =~ /^\d+$/;
 841             push @ids, $num;
 842         }
 843     } else {
 844         my $num = $req->{dtalkid};
 845         return fail($err, 203, 'xmlrpc.des.non_arifmetic', {'param'=>'dtalkid','value'=>$num}) unless $num =~ /^\d+$/;
 846         push @ids, $num;
 847     }
 848
 849     my $can_manage = $u->can_manage($journal);
 850
 851     my (%to_delauthor, %to_ban, %to_mark_spam);
 852
 853     my @comments;
 854     foreach my $id (@ids) {
 855         my $comm = LJ::Comment->new($journal, dtalkid => $id);
 856         return fail($err, 203, 'xmlrpc.des.no_comment_by_param',{'param'=>'dtalkid'}) unless $comm && ($comm->dtalkid == $id);
 857         return fail($err, 327, 'dtalkid:'.$comm->dtalkid) if $comm->is_deleted;
 858         return fail($err, 326, 'dtalkid:'.$comm->dtalkid) unless $comm->user_can_delete($u);
 859
 860         if($req->{'delauthor'}) {
 861
 862             # they can delete all comments posted by the same author
 863             # if they are the entry author, and the comment being deleted
 864             # has not been posted anonymously
 865             my $can_delauthor = $comm->poster && ( $can_manage || ( $u->userid == $comm->entry->poster->userid ) );
 866             return fail($err, 328, 'dtalkid:'.$comm->dtalkid) unless $can_delauthor;
 867             $to_delauthor{$comm->entry->jitemid}->{$comm->poster->userid} = 1;
 868         }
 869
 870         if($req->{'ban'}) {
 871
 872             # they can ban the comment author if they are the journal owner
 873             # and there is an author; also, they will not be able to ban
 874             # themselves
 875             my $can_sweep = ( $u && $comm->poster && $u->can_sweep($journal) );
 876             my $can_ban   = ( $can_manage || $can_sweep ) && $comm->poster && ( $u->userid != $comm->poster->userid );
 877             return fail($err, 329, 'dtalkid:'.$comm->dtalkid) unless $can_ban;
 878             $to_ban{$comm->poster->userid} = $comm->poster;
 879         }
 880
 881         if($req->{'spam'}) {
 882
 883             # they can mark as spam unless the comment is their own;
 884             # they don't need to be the community maintainer to do that
 885             my $can_mark_spam = LJ::Talk::can_mark_spam($u, $journal, $comm->poster, $comm)
 886                 && $comm->poster && ( $u->userid != $comm->poster->userid );
 887             return fail($err, 330, 'dtalkid:'.$comm->dtalkid) unless $can_mark_spam;
 888             $to_mark_spam{$comm->jtalkid} = $comm;
 889         }
 890
 891         push @comments, $comm;
 892     }
 893
 894     my @to_delete;
 895     if(!$req->{thread}){
 896         push @to_delete, @comments;
 897     } else {
 898         my %map_delete;
 899         foreach my $comment (@comments) {
 900             my @comment_tree = $comment->entry->comment_list;
 901             my @children = ($comment);
 902             while(my $item = shift @children){
 903                 return fail($err, 326, 'xmlrpc.des.foreign_comment', {'dtalkid'=>$item->dtalkid}) unless $item->user_can_delete($u);
 904                 $map_delete{$item->dtalkid} = $item unless $item->is_deleted;
 905                 push @children, grep { $_->{parenttalkid} == $item->{jtalkid} } @comment_tree;
 906             }
 907         }
 908         push @to_delete, values %map_delete;
 909     }
 910
 911     # delete all comments
 912     $_->delete for @to_delete;
 913
 914     # delete author comments (only for authors of root comment in thread)
 915     foreach my $jitemid (keys %to_delauthor) {
 916         foreach my $userid (keys %{$to_delauthor{$jitemid}}) {
 917             LJ::Talk::delete_author( $journal, $jitemid, $userid );
 918         }
 919     }
 920
 921     # ban authors (only for authors of root comment in thread)
 922     $journal->ban_user($_) for values %to_ban;
 923
 924     # mark comments as spam (only for root comment in thread)
 925     foreach my $comment (values %to_mark_spam) {
 926         my $poster = $comment->poster;
 927         LJ::Talk::mark_comment_as_spam( $journal, $comment->jtalkid );
 928         LJ::set_rel($journal, $poster, 'D');
 929
 930         LJ::User::UserlogRecord::SpamSet->create( $journal,
 931             'spammerid' => $poster->userid, 'remote' => $u );
 932
 933         LJ::run_hook('auto_suspender_for_spam', $poster->{userid});
 934     }
 935
 936     return {
 937         status => 'OK',
 938         result => @to_delete + 0,
 939         dtalkids => [ map {$_->dtalkid} @to_delete ],
 940         xc3 => {
 941             u => $u,
 942         }
 943     };
 944 }
 945
 946 =head updatecomments
 947     Use that function to update comments statuses:
 948         single or  multiple
 949         complete thread or root ony
 950 =cut
 951
 952 sub updatecomments {
 953     my ($req, $err, $flags) = @_;
 954     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'updatecomments');
 955
 956     my $u = $flags->{'u'};
 957     my $journal;
 958     if($req->{journal}) {
 959         return fail($err,100) unless LJ::canonical_username($req->{journal});
 960         $journal = LJ::load_user($req->{journal}) or return fail($err, 100);
 961     } elsif($req->{journalid}) {
 962         $journal = LJ::load_userid($req->{journalid}) or return fail($err, 100);
 963     } else {
 964         $journal = $u;
 965     }
 966
 967     return fail($err, 200, 'xmlrpc.des.or',{'first'=>'dtalkid','second'=>'dtalkids'}) unless($req->{dtalkid} || $req->{dtalkids});
 968
 969     my @ids;
 970     if ($req->{dtalkids}) {
 971         foreach my $num (split(/\s*,\s*/, $req->{'dtalkids'})) {
 972             return fail($err, 203, 'xmlrpc.des.non_arifmetic', {'param'=>'dtalkid', 'value'=>$num}) unless $num =~ /^\d+$/;
 973             push @ids, $num;
 974         }
 975     } else {
 976         my $num = $req->{dtalkid};
 977         return fail($err, 203, 'xmlrpc.des.non_arifmetic', {'param'=>'dtalkid', 'value'=>$num}) unless $num =~ /^\d+$/;
 978         push @ids, $num;
 979     }
 980
 981     my $action = $req->{action};
 982     return fail($err, 200, "action") unless($action);
 983     return fail($err, 203, "action") unless($action =~ /^screen|unscreen|freeze|unfreeze|unspam$/);
 984
 985     my $can_method = ($action =~ /unspam/ ? "LJ::Talk::can_unmark_spam" :  "LJ::Talk::can_$action");
 986     $can_method = \&{$can_method};
 987
 988     my @comments;
 989     foreach my $id (@ids) {
 990         my $comm = LJ::Comment->new($journal, dtalkid => $id);
 991         return fail($err, 203, 'xmlrpc.des.no_comment_by_param',{'param'=>'dtalkid'}) unless $comm && ($comm->dtalkid == $id);
 992         return fail($err, 327, 'dtalkid:'.$comm->dtalkid) if $comm->is_deleted;
 993         return fail($err, 326, 'dtalkid:'.$comm->dtalkid) unless $can_method->($u, $journal, $comm->entry->poster, $comm->poster);
 994         push @comments, $comm;
 995     }
 996
 997     # get first entry
 998     my $jitemid = $comments[0]->entry->jitemid;
 999
1000     # get list of comments to process
1001     my @to_update;
1002     if(!$req->{thread} || $action =~ /freeze|unfreeze/) {
1003         push @to_update, @comments;
1004     } else {    # get all elements from threads
1005         my %map_update;
1006         foreach my $comment (@comments) {
1007             my @comment_tree = $comment->entry->comment_list;
1008             my @children = ($comment);
1009             while(my $item = shift @children){
1010                 next if $item->is_deleted;
1011                 return fail($err, 326, 'dtalkid:'.$item->dtalkid) unless $can_method->($u, $journal, $item->entry->poster, $item->poster);
1012                 $map_update{$item->dtalkid} = $item;
1013                 push @children, grep { $_->{parenttalkid} == $item->{jtalkid} } @comment_tree;
1014             }
1015         }
1016         push @to_update, values %map_update;
1017     }
1018
1019     # process comments
1020     my $method;
1021     if ($action =~ /screen|unscreen|unspam/) {
1022         $method = \&{"LJ::Talk::$action".'_comment'};
1023         $method->($journal, $jitemid, map { $_->{jtalkid} } @to_update);
1024     } elsif ($action =~ /freeze|unfreeze/) {
1025         $method = \&{"LJ::Talk::$action".'_thread'};
1026         $method->($journal, $jitemid, map { $_->{jtalkid} } @to_update);
1027     }
1028
1029     return {
1030         status => 'OK',
1031         result => @to_update + 0,
1032         dtalkids => [ map {$_->dtalkid} @to_update ],
1033         xc3 => {
1034             u => $u,
1035         }
1036     };
1037 }
1038
1039 sub screencomments {
1040     my ($req, $err, $flags) = @_;
1041     return undef unless authenticate($req, $err, $flags);
1042
1043     my $journal = $req->{journalid}?LJ::load_userid($req->{journalid}):$flags->{'u'};
1044     my $comment = LJ::Comment->new( $journal , dtalkid => $req->{dtalkid} );
1045     my $up = $comment->entry->poster;
1046     return fail($err, 300) unless LJ::Talk::can_screen($flags->{'u'}, $journal, $up, $comment->poster);
1047
1048     my @to_screen;
1049
1050     if( !$req->{recursive}){
1051         push @to_screen, $comment;
1052     }else{
1053         my @comment_tree = $comment->entry->comment_list;
1054         my @children = ($comment);
1055         while(my $item = shift @children){
1056             return fail($err, 300) unless LJ::Talk::can_screen($flags->{'u'}, $journal, $up, $item->poster);
1057             push @to_screen, $item;
1058             push @children, grep { $_->{parenttalkid} == $item->{jtalkid} } @comment_tree;
1059         }
1060     }
1061     LJ::Talk::screen_comment($journal, $comment->entry->jitemid, $_->{jtalkid}) for @to_screen;
1062
1063     return {
1064         status => 'OK',
1065         result => @to_screen + 0,
1066         xc3 => {
1067             u => $flags->{'u'}
1068         }
1069     };
1070 }
1071
1072 sub unscreencomments {
1073     my ($req, $err, $flags) = @_;
1074     return undef unless authenticate($req, $err, $flags);
1075
1076     my $journal = $req->{journalid}?LJ::load_userid($req->{journalid}):$flags->{'u'};
1077     my $comment = LJ::Comment->new( $journal , dtalkid => $req->{dtalkid} );
1078     my $up = $comment->entry->poster;
1079     return fail($err, 300) unless LJ::Talk::can_unscreen($flags->{'u'}, $journal, $up, $comment->poster);
1080
1081     my @to_screen;
1082
1083     if( !$req->{recursive}){
1084         push @to_screen, $comment;
1085     }else{
1086         my @comment_tree = $comment->entry->comment_list;
1087         my @children = ($comment);
1088         while(my $item = shift @children){
1089             return fail($err, 300) unless LJ::Talk::can_unscreen($flags->{'u'}, $journal, $up, $item->poster);
1090             push @to_screen, $item;
1091             push @children, grep { $_->{parenttalkid} == $item->{jtalkid} } @comment_tree;
1092         }
1093     }
1094     LJ::Talk::unscreen_comment($journal, $comment->entry->jitemid, $_->{jtalkid}) for @to_screen;
1095
1096     return {
1097         status => 'OK',
1098         result => @to_screen + 0,
1099         xc3 => {
1100             u => $flags->{'u'}
1101         }
1102     };
1103 }
1104
1105 sub freezecomments {
1106     my ($req, $err, $flags) = @_;
1107     return undef unless authenticate($req, $err, $flags);
1108
1109     my $journal = $req->{journalid}?LJ::load_userid($req->{journalid}):$flags->{'u'};
1110     my $comment = LJ::Comment->new( $journal , dtalkid => $req->{dtalkid} );
1111     my $up = $comment->entry->poster;
1112     return fail($err, 300) unless LJ::Talk::can_freeze($flags->{'u'}, $journal, $up, $comment->poster);
1113
1114     LJ::Talk::freeze_thread($journal, $comment->entry->jitemid, $comment->{jtalkid});
1115
1116     return {
1117         status => 'OK',
1118         result => 1,
1119         xc3 => {
1120             u => $flags->{'u'}
1121         }
1122     };
1123 }
1124
1125 sub unfreezecomments {
1126     my ($req, $err, $flags) = @_;
1127     return undef unless authenticate($req, $err, $flags);
1128
1129     my $journal = $req->{journalid}?LJ::load_userid($req->{journalid}):$flags->{'u'};
1130     my $comment = LJ::Comment->new( $journal , dtalkid => $req->{dtalkid} );
1131     my $up = $comment->entry->poster;
1132     return fail($err, 300) unless LJ::Talk::can_unfreeze($flags->{'u'}, $journal, $up, $comment->poster);
1133
1134     LJ::Talk::unfreeze_thread($journal, $comment->entry->jitemid, $comment->{jtalkid});
1135
1136     return {
1137         status => 'OK',
1138         result => 1,
1139         xc3 => {
1140             u => $flags->{'u'}
1141         }
1142     };
1143 }
1144
1145 =head editcomment
1146     Edit one single comment, just content.
1147     To change statuses use other API functions.
1148 =cut
1149 sub editcomment {
1150     my ($req, $err, $flags) = @_;
1151     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'editcomment');
1152
1153     my $remote = $flags->{'u'};
1154     return fail($err, 318) if $remote && $remote->is_readonly;
1155
1156     my $journal;
1157     if($req->{journal}) {
1158         return fail($err, 100) unless LJ::canonical_username($req->{journal});
1159         $journal = LJ::load_user($req->{journal}) or return fail($err, 100);
1160     } elsif($req->{journalid}) {
1161         $journal = LJ::load_userid($req->{journalid}) or return fail($err, 100);
1162     } else {
1163         $journal = $remote;
1164     }
1165     return fail($err, 319) if $journal && $journal->is_readonly;
1166
1167     return fail($err, 200, "dtalkid") unless($req->{dtalkid});
1168
1169     my $comment = LJ::Comment->new($journal, dtalkid => $req->{dtalkid});
1170     return fail($err, 203, 'xmlrpc.des.and', {first=>'dtalkid',second=>'journal(id)'}) unless $comment;
1171
1172     my $entry = $comment->entry;
1173     return fail($err, 203, 'xmlrpc.des.and', {first=>'dtalkid',second=>'journal(id)'}) unless $entry;;
1174     return fail($err, 323) if $entry && $entry->is_suspended;
1175
1176     my $up = $entry->poster;
1177     my $parent = $comment->parent;
1178     return fail($err, 324) if $parent && $parent->{state} eq 'F';
1179
1180     my $new_comment = { map {$_ => $req->{$_}} grep { defined $req->{$_} } qw( picture_keyword preformat subject body) };
1181     $new_comment->{editid} = $req->{dtalkid};
1182     $new_comment->{body} = $comment->body_orig() unless($new_comment->{body}); # body can't be empty!
1183     $new_comment->{subject} = $comment->subject_orig() unless(defined $new_comment->{subject});
1184     $new_comment->{preformat} = $comment->prop('opt_preformatted') unless(defined $new_comment->{preformat});
1185
1186     my $errref;
1187     return fail($err, 325, $errref)
1188         unless LJ::Talk::Post::edit_comment(
1189             $up, $journal, $new_comment, $parent, {itemid => $entry->jitemid}, \$errref, $remote);
1190
1191     return {
1192         status => 'OK',
1193         commentlink => $comment->url,
1194         dtalkid     => $comment->dtalkid,
1195         xc3 => {
1196             u => $flags->{'u'}
1197         }
1198     };
1199 }
1200
1201 sub getrecentcomments {
1202     my ($req, $err, $flags) = @_;
1203     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getrecentcomments');
1204     my $u = $flags->{'u'};
1205
1206     my $journal;
1207     if($req->{journal}) {
1208         return fail($err,100) unless LJ::canonical_username($req->{journal});
1209         $journal = LJ::load_user($req->{journal}) or return fail($err, 100);
1210     } elsif ( $req->{journalid} ) {
1211         $journal = LJ::load_userid($req->{journalid}) or return fail($err, 100);
1212     } else {
1213         $journal = $u;
1214     }
1215     return fail($err,200,"journal") unless($journal);
1216
1217     my $count = $req->{itemshow};
1218     $count = 10 if !$count || ($count > 100) || ($count < 0);
1219
1220     my @recv = $journal->get_recent_talkitems($count, remote => $u);
1221     my @recv_talkids = map { $_->{'jtalkid'} } @recv;
1222     my %recv_userids = map { $_->{'posterid'} => 1} @recv;
1223     my $comment_text = LJ::get_talktext2($journal, @recv_talkids);
1224     my $users = LJ::load_userids(keys(%recv_userids));
1225     foreach my $comment ( @recv ) {
1226         $comment->{subject} = $comment_text->{$comment->{jtalkid}}[0];
1227         $comment->{text} = $comment_text->{$comment->{jtalkid}}[1];
1228
1229         $comment->{text} = LJ::trim_widgets(
1230             length     => $req->{trim_widgets},
1231             img_length => $req->{widgets_img_length},
1232             text      => $comment->{text},
1233             read_more => '<a href="' . $comment->url . '"> ...</a>',
1234         ) if $req->{trim_widgets};
1235
1236         if ($req->{'asxml'} && $comment->{text}) {
1237             my $tidy = LJ::Tidy->new();
1238             $comment->{text} = $tidy->clean( $comment->{text} );
1239         }
1240
1241         # add parameters to lj-tags
1242         #LJ::EmbedModule->expand_entry($users->{$comment->{posterid}}, \$comment->{text}, get_video_id => 1) if($req->{get_video_ids});
1243
1244         if ($req->{view}) {
1245             LJ::EmbedModule->expand_entry($users->{$comment->{posterid}}, \$comment->{text}, edit => 1) if $req->{view} eq 'stored';
1246         } elsif ($req->{parseljtags}) {
1247             $comment->{text} = LJ::convert_lj_tags_to_links(
1248                 event => $comment->{text},
1249                 embed_url => $comment->url );
1250         }
1251
1252         my $poster = $users->{$comment->{posterid}};
1253         $comment->{postername} = $poster->username if $poster;
1254
1255         if ($poster && $poster->identity ) {
1256             my $i = $poster->identity;
1257             $comment->{'identity_type'} = $i->pretty_type;
1258             $comment->{'identity_value'} = $i->value;
1259             $comment->{'identity_url'} = $i->url($poster);
1260             $comment->{'identity_display'} = $poster->display_name;
1261         }
1262
1263         my $comm_obj = LJ::Comment->new($journal, jtalkid => $comment->{jtalkid});
1264         my $userpic = $comm_obj->userpic;
1265         $comment->{poster_userpic_url} = $userpic && $userpic->url;
1266
1267     }
1268
1269     return {
1270         status => 'OK',
1271         comments => [ @recv ],
1272         xc3 => {
1273             u => $u
1274         }
1275     };
1276 }
1277
1278 sub getfriendspage
1279 {
1280     my ($req, $err, $flags) = @_;
1281     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getfriendspage');
1282     my $u = $flags->{'u'};
1283
1284     my $itemshow = (defined $req->{itemshow}) ? $req->{itemshow} : 100;
1285     return fail($err, 209, 'xmlrpc.des.bad_value', {'param'=>'itemshow'}) if $itemshow ne int($itemshow ) or $itemshow  <= 0 or $itemshow  > 100;
1286     my $skip = (defined $req->{skip}) ? $req->{skip} : 0;
1287     return fail($err, 209, 'xmlrpc.des.bad_value', {'param'=>'skip'}) if $skip ne int($skip ) or $skip  < 0 or $skip  > 100;
1288
1289     my $lastsync = int $req->{lastsync};
1290     my $before = int $req->{before};
1291     my $before_count = 0;
1292     my $before_skip = 0;
1293     if ($before){
1294         $before_skip = $skip + 0;
1295         $skip = 0;
1296     }
1297
1298     my %get_params = (
1299         u          => $u,
1300         userid     => $u->{'userid'},
1301         remote     => $u,
1302         dateformat => 'S2',
1303         itemshow   => $itemshow,
1304         filter     => $req->{groupmask},
1305         showtypes  => $req->{journaltype},
1306     );
1307
1308     my @entries = LJ::get_friend_items({
1309         %get_params,
1310         'skip' => $skip,
1311         'filter_by_tags' => 1,
1312     });
1313
1314     my @attrs = qw/subject_raw event_raw journalid posterid ditemid security reply_count userpic props security/;
1315
1316     my @uids;
1317
1318     my @res = ();
1319     while (my $ei = shift @entries) {
1320
1321         next unless $ei;
1322
1323         # exit cycle if maximum friend items limit reached
1324         last
1325             if scalar @res >= FRIEND_ITEMS_LIMIT;
1326
1327         # if passed lastsync argument - skip items with logtime less than lastsync
1328         if($lastsync) {
1329             next
1330                 if $LJ::EndOfTime - $ei->{rlogtime} <= $lastsync;
1331         }
1332
1333         if($before) {
1334             last if @res >= $itemshow;
1335             push @entries, LJ::get_friend_items({
1336                 %get_params,
1337                 'skip' => $skip + ($before_count += $itemshow),
1338                 'filter_by_tags' => 1,
1339             }) unless @entries;
1340             next if $LJ::EndOfTime - $ei->{rlogtime} > $before;
1341             next if $before_skip-- > 0;
1342         }
1343
1344         my $entry = LJ::Entry->new_from_item_hash($ei);
1345         next unless $entry;
1346         next unless $entry->visible_to($u);
1347
1348         # event result data structure
1349         my %h = ();
1350
1351         my $repost_props = { use_repost_signature => 0 };
1352         my ($original_entry, $repost_entry, $event_raw);
1353         my $opts = {original_post_obj => \$original_entry, repost_obj => \$repost_entry, event => \$event_raw};
1354         if (LJ::Entry::Repost->substitute_content( $entry, $opts, $repost_props )) {
1355             $h{repost} = 1;
1356             $entry = $original_entry;
1357         }
1358
1359         $entry->normalize_props() unless $flags->{'noauth'};
1360
1361         # Add more data for public posts
1362         foreach my $method (@attrs) {
1363             $h{$method} = $entry->$method;
1364         }
1365
1366         if($h{repost}){
1367             $h{event_raw} = $event_raw;
1368             $h{original_entry_url} = $original_entry->url;
1369             $h{repostername} = $repost_entry->journal->username;
1370             $h{postername} = $original_entry->poster->username;
1371             $h{journalname} = $entry->journal->username;
1372             my $userpic = $original_entry->userpic;
1373             $h{poster_userpic_url} = $userpic && $userpic->url;
1374         }
1375
1376
1377         $h{event_raw} = LJ::trim_widgets(
1378             length    => $req->{trim_widgets},
1379             img_length => $req->{widgets_img_length},
1380             text      => $h{event_raw},
1381             read_more => '<a href="' . $entry->url . '"> ...</a>',
1382         ) if $req->{trim_widgets};
1383
1384         LJ::EmbedModule->expand_entry($entry->poster, \$h{event_raw}, get_video_id => 1) if $req->{get_video_ids};
1385         LJ::Poll->expand_entry(\$h{event_raw}, getpolls => 1, viewer => $u ) if $req->{get_polls};
1386
1387         if ($req->{view}) {
1388             LJ::EmbedModule->expand_entry($entry->poster, \$h{event_raw}, edit => 1) if $req->{view} eq 'stored';
1389         } elsif ($req->{parseljtags}) {
1390             $h{event_raw} = LJ::convert_lj_tags_to_links(
1391                 event => $h{event_raw},
1392                 embed_url => $entry->url)
1393         }
1394
1395         if ($req->{'asxml'}) {
1396             my $tidy = LJ::Tidy->new();
1397             $h{event_raw} = $tidy->clean( $h{event_raw} );
1398         }
1399
1400         #userpic
1401         $h{poster_userpic_url} = $h{userpic} && $h{userpic}->url;
1402
1403         # log time value
1404         $h{logtime} = $LJ::EndOfTime - $ei->{rlogtime};
1405         $h{do_captcha} = LJ::Talk::Post::require_captcha_test($u, $entry->poster, '', $h{ditemid}, 1)?1:0;
1406
1407         push @res, \%h;
1408
1409         push @uids, $h{posterid}, $h{journalid};
1410     }
1411
1412     my $users = LJ::load_userids(@uids);
1413
1414     foreach (@res) {
1415         $_->{journalname} = $users->{ $_->{journalid} }->{'user'};
1416         $_->{journaltype} = $users->{ $_->{journalid} }->{'journaltype'};
1417         $_->{journalurl}  = $users->{ $_->{journalid} }->journal_base;
1418         delete $_->{journalid};
1419         $_->{postername} = $users->{ $_->{posterid} }->{'user'};
1420         $_->{postertype} = $users->{ $_->{posterid} }->{'journaltype'};
1421         $_->{posterurl}  = $users->{ $_->{posterid} }->journal_base;
1422         if ($users->{ $_->{posterid} }->identity) {
1423                 my $i = $users->{ $_->{posterid} }->identity;
1424                 $_->{'identity_type'} = $i->pretty_type;
1425                 $_->{'identity_value'} = $i->value;
1426                 $_->{'identity_url'} = $i->url($users->{ $_->{posterid} });
1427                 $_->{'identity_display'} = $users->{ $_->{posterid} }->display_name;
1428         }
1429         delete $_->{posterid};
1430         delete $_->{props}->{repost_offer};
1431     }
1432
1433     LJ::run_hooks("getfriendspage", {userid => $u->userid, });
1434
1435     return {
1436         entries => [ @res ],
1437         skip => $skip,
1438         xc3 => {
1439             u => $u
1440         }
1441     };
1442 }
1443
1444
1445 sub getinbox
1446 {
1447     my ($req, $err, $flags) = @_;
1448     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getinbox');
1449     my $u = $flags->{'u'};
1450
1451     my $itemshow = (defined $req->{itemshow}) ? $req->{itemshow} : 100;
1452     return fail($err, 209, 'xmlrpc.des.bad_value', {'param'=>'itemshow'}) if $itemshow ne int($itemshow ) or $itemshow  <= 0 or $itemshow  > 100;
1453     my $skip = (defined $req->{skip}) ? $req->{skip} : 0;
1454     return fail($err, 209, 'xmlrpc.des.bad_value', {'param'=>'skip'}) if $skip ne int($skip ) or $skip  < 0 or $skip  > 100;
1455
1456     # get the user's inbox
1457     my $inbox = $u->notification_inbox or return fail($err, 500, 'xmlrpc.des.inbox_fail');
1458
1459     my %type_number = (
1460         Befriended           => 1,
1461         Birthday             => 2,
1462         CommunityInvite      => 3,
1463         CommunityJoinApprove => 4,
1464         CommunityJoinReject  => 5,
1465         CommunityJoinRequest => 6,
1466         Defriended           => 7,
1467         InvitedFriendJoins   => 8,
1468         JournalNewComment    => 9,
1469         JournalNewEntry      => 10,
1470         NewUserpic           => 11,
1471         NewVGift             => 12,
1472         OfficialPost         => 13,
1473         PermSale             => 14,
1474         PollVote             => 15,
1475         SupOfficialPost      => 16,
1476         UserExpunged         => 17,
1477         UserMessageRecvd     => 18,
1478         UserMessageSent      => 19,
1479         UserNewComment       => 20,
1480         UserNewEntry         => 21,
1481     );
1482     my %number_type = reverse %type_number;
1483
1484     my @notifications;
1485
1486     my $sync_date;
1487     # check lastsync for valid date
1488     if ($req->{'lastsync'}) {
1489         $sync_date = int $req->{'lastsync'};
1490         if($sync_date <= 0) {
1491             return fail($err,203,'xmlrpc.des.date_unixtime',{'param'=>'syncitems'});
1492         }
1493     }
1494
1495     if ($req->{gettype}) {
1496         $req->{gettype} = [$req->{gettype}] unless ref($req->{gettype});
1497
1498         my %filter;
1499         $filter{"LJ::Event::" . $number_type{$_}} = 1 for @{$req->{gettype}};
1500         @notifications = grep { exists $filter{$_->event->class} } $inbox->items;
1501
1502     } else {
1503         @notifications = $inbox->all_items;
1504     }
1505
1506     # By default, notifications are sorted as "oldest are the first"
1507     # Reverse it by "newest are the first"
1508     @notifications = reverse @notifications;
1509
1510     if (my $before = $req->{'before'}) {
1511         return fail($err,203,'xmlrpc.des.date_unixtime',{'param'=>'syncitems'}) if $before <= 0;
1512         @notifications = grep {$_->when_unixtime <= $before} @notifications;
1513     }
1514
1515     $itemshow = scalar @notifications - $skip if scalar @notifications < $skip + $itemshow;
1516
1517     my @res;
1518     foreach my $item (@notifications[$skip .. $itemshow + $skip - 1]) {
1519         next if $sync_date && $item->when_unixtime < $sync_date;
1520
1521         my $raw = $item->event->raw_info($u, {extended => $req->{extended}});
1522
1523         my $type_index = $type_number{$raw->{type}};
1524         if (defined $type_index) {
1525             $raw->{type} = $type_index;
1526         } else {
1527             $raw->{typename} = $raw->{type};
1528             $raw->{type} = 0;
1529         }
1530
1531         $raw->{state} = $item->{state};
1532
1533         push @res, { %$raw,
1534                      when   => $item->when_unixtime,
1535                      qid    => $item->qid,
1536                    };
1537     }
1538
1539     return {
1540         'skip'  => $skip,
1541         'items' => \@res,
1542         'login' => $u->user,
1543         'journaltype' => $u->journaltype,
1544         xc3 => {
1545             u => $u
1546         }
1547     };
1548 }
1549
1550 sub setmessageread {
1551     my ($req, $err, $flags) = @_;
1552
1553     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'setmessageread');
1554
1555     my $u = $flags->{'u'};
1556
1557     # get the user's inbox
1558     my $inbox = $u->notification_inbox or return fail($err, 500, 'xmlrpc.des.inbox_fail');
1559     my @result;
1560
1561     # passing requested ids for loading
1562     my @notifications = $inbox->all_items;
1563
1564     # Try to select messages by qid if specified
1565     my @qids = @{$req->{qid}};
1566     if (scalar @qids) {
1567         foreach my $qid (@qids) {
1568             my $item = eval {LJ::NotificationItem->new($u, $qid)};
1569             $item->mark_read if $item;
1570             push @result, { qid => $qid, result => 'set read'  };
1571         }
1572     } else { # Else select it by msgid for back compatibility
1573         # make hash of requested message ids
1574         my %requested_items = map { $_ => 1 } @{$req->{messageid}};
1575
1576         # proccessing only requested ids
1577         foreach my $item (@notifications) {
1578             my $msgid = $item->event->raw_info($u)->{msgid};
1579             next unless $requested_items{$msgid};
1580             # if message already read -
1581             if ($item->{state} eq 'R') {
1582                 push @result, { msgid => $msgid, result => 'already red' };
1583                 next;
1584             }
1585             # in state no 'R' - marking as red
1586             $item->mark_read;
1587             push @result, { msgid => $msgid, result => 'set read'  };
1588         }
1589     }
1590
1591     return {
1592         result => \@result,
1593         xc3 => {
1594             u => $u
1595         }
1596     };
1597 }
1598
1599 sub sendmessage
1600 {
1601     my ($req, $err, $flags) = @_;
1602
1603     return fail($err, 315) if $LJ::DISABLED{user_messaging};
1604
1605     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'sendmessage');
1606     my $u = $flags->{'u'};
1607
1608     return fail($err, 305) if $u->statusvis eq 'S'; # suspended cannot send private messages
1609
1610     my $msg_limit = LJ::get_cap($u, "usermessage_length");
1611
1612     my @errors;
1613
1614     my $subject_text = LJ::strip_html($req->{'subject'});
1615     return fail($err, 208, 'subject')
1616         unless LJ::text_in($subject_text);
1617
1618     # strip HTML from body and test encoding and length
1619     my $body_text = LJ::strip_html($req->{'body'});
1620     return fail($err, 208, 'body')
1621         unless LJ::text_in($body_text);
1622
1623     my ($msg_len_b, $msg_len_c) = LJ::text_length($body_text);
1624     return fail($err, 212, 'xmlrpc.des.message_long', {'len'=>LJ::commafy($msg_len_c), 'limit'=>LJ::commafy($msg_limit)})
1625         unless ($msg_len_c <= $msg_limit);
1626
1627
1628     return fail($err, 213, 'xmlrpc.des.message_empty', {'len'=>LJ::commafy($msg_len_c)})
1629         if ($msg_len_c <= 0);
1630
1631     my @to = (ref $req->{'to'}) ? @{$req->{'to'}} : ($req->{'to'});
1632     return fail($err, 200) unless scalar @to;
1633
1634     # remove duplicates
1635     my %to = map { lc($_), 1 } @to;
1636     @to = keys %to;
1637
1638     my @msg;
1639     BML::set_language('en') unless BML::get_language();
1640
1641     foreach my $to (@to) {
1642         my $tou = LJ::load_user($to);
1643         return fail($err, 100, $to)
1644             unless $tou;
1645
1646         my $msg = LJ::Message->new({
1647                     journalid => $u->userid,
1648                     otherid => $tou->userid,
1649                     subject => $subject_text,
1650                     body => $body_text,
1651                     parent_msgid => defined $req->{'parent'} ? $req->{'parent'} + 0 : undef,
1652                     userpic => $req->{'userpic'} || undef,
1653                   });
1654
1655         push @msg, $msg
1656             if $msg->can_send(\@errors);
1657     }
1658     return fail($err, 203, join('; ', @errors))
1659         if scalar @errors;
1660
1661     foreach my $msg (@msg) {
1662         $msg->send(\@errors);
1663     }
1664
1665     return {
1666         'sent_count' => scalar @msg,
1667         'msgid' => [ grep { $_ } map { $_->msgid } @msg ],
1668         (@errors ? ('last_errors' => \@errors) : () ),
1669         xc3 => {
1670             u => $u
1671         }
1672     };
1673 }
1674
1675 sub login
1676 {
1677     my ($req, $err, $flags) = @_;
1678     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'login');
1679     return undef unless check_altusage($req, $err, $flags);
1680
1681     my $u = $flags->{'u'};
1682     my $uowner = $flags->{'u_owner'} || $u;
1683
1684     my $res = {
1685         xc3 => {
1686             u => $u
1687         }
1688     };
1689     my $ver = $req->{'ver'};
1690
1691     ## check for version mismatches
1692     ## non-Unicode installations can't handle versions >=1
1693
1694     return fail($err,207, 'xmlrpc.des.not_unicode')
1695         if $ver>=1 and not $LJ::UNICODE;
1696
1697     # do not let locked people log in
1698     return fail($err, 308) if $u->{statusvis} eq 'L';
1699
1700     ## return a message to the client to be displayed (optional)
1701     login_message($req, $res, $flags);
1702     LJ::text_out(\$res->{'message'}) if $ver>=1 and defined $res->{'message'};
1703
1704     ## report what shared journals this user may post in
1705     $res->{'usejournals'} = list_usejournals($u) if (LJ::u_equals($u, $uowner));
1706
1707     # identity users can only post to communities
1708     # return fail( $err, 150 )
1709     #    if $u->is_identity and LJ::u_equals( $u, $uowner );
1710
1711
1712     ## return their friend groups
1713     if (LJ::u_equals($u, $uowner)) {
1714         $res->{'friendgroups'} = list_friendgroups($u);
1715         return fail($err, 502, 'xmlrpc.des.friend_groups_fail') unless $res->{'friendgroups'};
1716         if ($ver >= 1) {
1717             foreach (@{$res->{'friendgroups'}}) {
1718                 LJ::text_out(\$_->{'name'});
1719             }
1720         }
1721     }
1722
1723     ## if they gave us a number of moods to get higher than, then return them
1724     if (defined $req->{'getmoods'}) {
1725         $res->{'moods'} = list_moods($req->{'getmoods'});
1726         if ($ver >= 1) {
1727             # currently all moods are in English, but this might change
1728             foreach (@{$res->{'moods'}}) { LJ::text_out(\$_->{'name'}) }
1729         }
1730     }
1731
1732     ### picture keywords, if they asked for them.
1733     if ($req->{'getpickws'} || $req->{'getpickwurls'}) {
1734         my $pickws = list_pickws($uowner);
1735         @$pickws = sort { lc($a->[0]) cmp lc($b->[0]) } @$pickws;
1736         $res->{'pickws'} = [ map { $_->[0] } @$pickws ] if $req->{'getpickws'};
1737         if ($req->{'getpickwurls'}) {
1738             if ($uowner->{'defaultpicid'}) {
1739                  $res->{'defaultpicurl'} = "$LJ::USERPIC_ROOT/$uowner->{'defaultpicid'}/$uowner->{'userid'}";
1740             }
1741             $res->{'pickwurls'} = [ map {
1742                 "$LJ::USERPIC_ROOT/$_->[1]/$uowner->{'userid'}"
1743             } @$pickws ];
1744         }
1745         if ($ver >= 1) {
1746             # validate all text
1747             foreach(@{$res->{'pickws'}}) { LJ::text_out(\$_); }
1748             foreach(@{$res->{'pickwurls'}}) { LJ::text_out(\$_); }
1749             LJ::text_out(\$res->{'defaultpicurl'});
1750         }
1751     }
1752     ## return caps, if they asked for them
1753     if ($req->{'getcaps'} && $u->can_manage($uowner)) {
1754         $res->{'caps'} = $uowner->caps;
1755     }
1756
1757     ## return client menu tree, if requested
1758     if ($req->{'getmenus'} ) {
1759         $res->{'menus'} = hash_menus($uowner);
1760         if ($ver >= 1) {
1761             # validate all text, just in case, even though currently
1762             # it's all English
1763             foreach (@{$res->{'menus'}}) {
1764                 LJ::text_out(\$_->{'text'});
1765                 LJ::text_out(\$_->{'url'}); # should be redundant
1766             }
1767         }
1768     }
1769
1770     ## tell some users they can hit the fast servers later.
1771     $res->{'fastserver'} = 1 if LJ::get_cap($uowner, "fastserver");
1772
1773     ## user info
1774     $res->{'username'} = $uowner->{'user'};
1775     $res->{'userid'} = $uowner->{'userid'};
1776     $res->{'fullname'} = $uowner->{'name'};
1777     LJ::text_out(\$res->{'fullname'}) if $ver >= 1;
1778
1779     # Identity info
1780     if ($uowner->is_identity){
1781         my $i = $uowner->identity;
1782         $res->{'identity_type'}    = $i->pretty_type;
1783         $res->{'identity_value'}   = $i->value;
1784         $res->{'identity_url'}     = $i->url($uowner);
1785         $res->{'identity_display'} = $uowner->display_name;
1786     } else {
1787         foreach (qw(identity_display identity_url identity_value identity_type)) {
1788             $res->{$_} = '';
1789         }
1790     }
1791
1792     if ($req->{'clientversion'} =~ /^\S+\/\S+$/) {
1793         eval {
1794             LJ::Request->notes("clientver", $req->{'clientversion'});
1795         };
1796     }
1797
1798     ## update or add to clientusage table
1799     if ($req->{'clientversion'} =~ /^\S+\/\S+$/ &&
1800         ! $LJ::DISABLED{'clientversionlog'})
1801     {
1802         my $client = $req->{'clientversion'};
1803
1804         return fail($err, 208, 'xmlrpc.des.bad_value', {'param'=>'clientversion'})
1805             if $ver >= 1 and not LJ::text_in($client);
1806
1807         my $dbh = LJ::get_db_writer();
1808         my $qclient = $dbh->quote($client);
1809         my $cu_sql = "REPLACE INTO clientusage (userid, clientid, lastlogin) " .
1810             "SELECT $u->{'userid'}, clientid, NOW() FROM clients WHERE client=$qclient";
1811         my $sth = $dbh->prepare($cu_sql);
1812         $sth->execute;
1813         unless ($sth->rows) {
1814             # only way this can be 0 is if client doesn't exist in clients table, so
1815             # we need to add a new row there, to get a new clientid for this new client:
1816             $dbh->do("INSERT INTO clients (client) VALUES ($qclient)");
1817             # and now we can do the query from before and it should work:
1818             $sth = $dbh->prepare($cu_sql);
1819             $sth->execute;
1820         }
1821     }
1822
1823     return $res;
1824 }
1825
1826 sub getfriendgroups
1827 {
1828     my ($req, $err, $flags) = @_;
1829     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getfriendgroups');
1830     my $u = $flags->{'u'};
1831     my $res = {
1832         xc3 => {
1833             u => $u
1834         }
1835     };
1836
1837     $res->{'friendgroups'} = list_friendgroups($u);
1838     return fail($err, 502, 'xmlrpc.des.friend_groups_fail') unless $res->{'friendgroups'};
1839     if ($req->{'ver'} >= 1) {
1840         foreach (@{$res->{'friendgroups'} || []}) {
1841             LJ::text_out(\$_->{'name'});
1842         }
1843     }
1844
1845     return $res;
1846 }
1847
1848 sub getusertags
1849 {
1850     my ($req, $err, $flags) = @_;
1851     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getusertags');
1852     return undef unless check_altusage($req, $err, $flags);
1853
1854     my $u = $flags->{'u'};
1855     my $uowner = $flags->{'u_owner'} || $u;
1856     return fail($req, 502) unless $u && $uowner;
1857
1858     my $tags = LJ::Tags::get_usertags($uowner, { remote => $u });
1859     return {
1860         tags => [ values %$tags ],
1861         xc3 => {
1862             u => $u
1863         }
1864     };
1865 }
1866
1867 sub getuserpics
1868 {
1869     my ($req, $err, $flags) = @_;
1870
1871     $flags->{'allow_anonymous'} = 1;
1872     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getuserpics');
1873     $flags->{'ignorecanuse'} = 1;   #    function return public info
1874     return undef unless check_altusage($req, $err, $flags);
1875
1876     my $u = $flags->{'u'};
1877     my $uowner = $flags->{'u_owner'} || $u;
1878     return fail($err, 502) unless $uowner;
1879
1880     my $res = {
1881         xc3 => {
1882             u => $u
1883         }
1884     };
1885
1886     my $pickws = list_pickws($uowner);
1887     @$pickws = sort { lc($a->[0]) cmp lc($b->[0]) } @$pickws;
1888     $res->{'pickws'} = [ map { $_->[0] } @$pickws ];
1889
1890     if ($uowner->{'defaultpicid'}) {
1891              $res->{'defaultpicurl'} = "$LJ::USERPIC_ROOT/$uowner->{'defaultpicid'}/$uowner->{'userid'}";
1892     }
1893     $res->{'pickwurls'} = [ map {
1894          "$LJ::USERPIC_ROOT/$_->[1]/$uowner->{'userid'}"
1895         } @$pickws ];
1896     # validate all text
1897     foreach(@{$res->{'pickws'}}) { LJ::text_out(\$_); }
1898     foreach(@{$res->{'pickwurls'}}) { LJ::text_out(\$_); }
1899     LJ::text_out(\$res->{'defaultpicurl'});
1900
1901     return $res;
1902 }
1903
1904
1905 sub getfriends
1906 {
1907     my ($req, $err, $flags) = @_;
1908     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getfriends');
1909
1910     return fail($req,502) unless LJ::get_db_reader();
1911     my $u = $flags->{'u'};
1912     my $res = {
1913         xc3 => {
1914             u => $u
1915         }
1916     };
1917
1918     if ($req->{'includegroups'}) {
1919         $res->{'friendgroups'} = list_friendgroups($u);
1920         return fail($err, 502, 'xmlrpc.des.friend_groups_fail') unless $res->{'friendgroups'};
1921         if ($req->{'ver'} >= 1) {
1922             foreach (@{$res->{'friendgroups'} || []}) {
1923                 LJ::text_out(\$_->{'name'});
1924             }
1925         }
1926     }
1927     # TAG:FR:protocol:getfriends_of
1928     if ($req->{'includefriendof'}) {
1929         $res->{'friendofs'} = list_friends($u, {
1930             'limit' => $req->{'friendoflimit'},
1931             'friendof' => 1,
1932         });
1933         if ($req->{'ver'} >= 1) {
1934             foreach(@{$res->{'friendofs'}}) { LJ::text_out(\$_->{'fullname'}) };
1935         }
1936     }
1937     # TAG:FR:protocol:getfriends
1938     $res->{'friends'} = list_friends($u, {
1939         'limit' => $req->{'friendlimit'},
1940         'includebdays' => $req->{'includebdays'},
1941     });
1942     if ($req->{'ver'} >= 1) {
1943         foreach(@{$res->{'friends'}}) { LJ::text_out(\$_->{'fullname'}) };
1944     }
1945
1946     return $res;
1947 }
1948
1949 sub friendof
1950 {
1951     my ($req, $err, $flags) = @_;
1952     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'friendof');
1953     return fail($req,502) unless LJ::get_db_reader();
1954     my $u = $flags->{'u'};
1955     my $res = {
1956         xc3 => {
1957             u => $u
1958         }
1959     };
1960
1961     # TAG:FR:protocol:getfriends_of2 (same as TAG:FR:protocol:getfriends_of)
1962     $res->{'friendofs'} = list_friends($u, {
1963         'friendof' => 1,
1964         'limit' => $req->{'friendoflimit'},
1965     });
1966     if ($req->{'ver'} >= 1) {
1967         foreach(@{$res->{'friendofs'}}) { LJ::text_out(\$_->{'fullname'}) };
1968     }
1969
1970     return $res;
1971 }
1972
1973 sub checkfriends
1974 {
1975     my ($req, $err, $flags) = @_;
1976     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'checkfriends');
1977     my $u = $flags->{'u'};
1978     my $res = {
1979         xc3 => {
1980             u => $u
1981         }
1982     };
1983
1984     # return immediately if they can't use this mode
1985     unless (LJ::get_cap($u, "checkfriends")) {
1986         $res->{'new'} = 0;
1987         $res->{'interval'} = 36000;  # tell client to bugger off
1988         return $res;
1989     }
1990
1991     ## have a valid date?
1992     my $lastupdate = $req->{'lastupdate'};
1993     if ($lastupdate) {
1994         return fail($err,203) unless
1995             ($lastupdate =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
1996     } else {
1997         $lastupdate = "0000-00-00 00:00:00";
1998     }
1999
2000     my $interval = LJ::get_cap_min($u, "checkfriends_interval");
2001     $res->{'interval'} = $interval;
2002
2003     my $mask;
2004     if ($req->{'mask'} and $req->{'mask'} !~ /\D/) {
2005         $mask = $req->{'mask'};
2006     }
2007
2008     my $memkey = [$u->{'userid'},"checkfriends:$u->{userid}:$mask"];
2009     my $update = LJ::MemCache::get($memkey);
2010     unless ($update) {
2011         # TAG:FR:protocol:checkfriends (wants reading list of mask, not "friends")
2012         my $fr = LJ::get_friends($u, $mask);
2013         unless ($fr && %$fr) {
2014             $res->{'new'} = 0;
2015             $res->{'lastupdate'} = $lastupdate;
2016             return $res;
2017         }
2018         if (@LJ::MEMCACHE_SERVERS) {
2019             my $tu = LJ::get_timeupdate_multi({ memcache_only => 1 }, keys %$fr);
2020             my $max = 0;
2021             while ($_ = each %$tu) {
2022                 $max = $tu->{$_} if $tu->{$_} > $max;
2023             }
2024             $update = LJ::TimeUtil->mysql_time($max) if $max;
2025         } else {
2026             my $dbr = LJ::get_db_reader();
2027             unless ($dbr) {
2028                 # rather than return a 502 no-db error, just say no updates,
2029                 # because problem'll be fixed soon enough by db admins
2030                 $res->{'new'} = 0;
2031                 $res->{'lastupdate'} = $lastupdate;
2032                 return $res;
2033             }
2034             my $list = join(", ", map { int($_) } keys %$fr);
2035             if ($list) {
2036               my $sql = "SELECT MAX(timeupdate) FROM userusage ".
2037                   "WHERE userid IN ($list)";
2038               $update = $dbr->selectrow_array($sql);
2039             }
2040         }
2041         LJ::MemCache::set($memkey,$update,time()+$interval) if $update;
2042     }
2043     $update ||= "0000-00-00 00:00:00";
2044
2045     if ($req->{'lastupdate'} && $update gt $lastupdate) {
2046         $res->{'new'} = 1;
2047     } else {
2048         $res->{'new'} = 0;
2049     }
2050
2051     $res->{'lastupdate'} = $update;
2052
2053     return $res;
2054 }
2055
2056 sub getdaycounts
2057 {
2058     my ($req, $err, $flags) = @_;
2059     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getdaycounts');
2060     return undef unless check_altusage($req, $err, $flags);
2061
2062     my $u = $flags->{'u'};
2063     my $uowner = $flags->{'u_owner'} || $u;
2064     my $ownerid = $flags->{'ownerid'};
2065
2066     my $res = {
2067         xc3 => {
2068             u => $u
2069         }
2070     };
2071
2072     my $daycts = LJ::get_daycounts($uowner, $u);
2073     return fail($err,502) unless $daycts;
2074
2075     foreach my $day (@$daycts) {
2076         my $date = sprintf("%04d-%02d-%02d", $day->[0], $day->[1], $day->[2]);
2077         push @{$res->{'daycounts'}}, { 'date' => $date, 'count' => $day->[3] };
2078     }
2079
2080     return $res;
2081 }
2082
2083 sub common_event_validation
2084 {
2085     my ($req, $err, $flags) = @_;
2086
2087     # clean up event whitespace
2088     # remove surrounding whitespace
2089     $req->{event} =~ s/^\s+//;
2090     $req->{event} =~ s/\s+$//;
2091
2092     # convert line endings to unix format
2093     if ($req->{'lineendings'} eq "mac") {
2094         $req->{event} =~ s/\r/\n/g;
2095     } else {
2096         $req->{event} =~ s/\r//g;
2097     }
2098
2099     # date validation
2100     if ($req->{'year'} !~ /^\d\d\d\d$/ ||
2101         $req->{'year'} < 1970 ||    # before unix time started = bad
2102         $req->{'year'} > 2037)      # after unix time ends = worse!  :)
2103     {
2104         return fail($err,203,'xmlrpc.des.bad_value',{'param'=>'year'});
2105     }
2106     if ($req->{'mon'} !~ /^\d{1,2}$/ ||
2107         $req->{'mon'} < 1 ||
2108         $req->{'mon'} > 12)
2109     {
2110         return fail($err,203,'xmlrpc.des.bad_value',{'param'=>'month'});
2111     }
2112     if ($req->{'day'} !~ /^\d{1,2}$/ || $req->{'day'} < 1 ||
2113         $req->{'day'} > LJ::TimeUtil->days_in_month($req->{'mon'},
2114                                           $req->{'year'}))
2115     {
2116         return fail($err,203,'xmlrpc.des.bad_value',{'param'=>'day of month'});
2117     }
2118     if ($req->{'hour'} !~ /^\d{1,2}$/ ||
2119         $req->{'hour'} < 0 || $req->{'hour'} > 23)
2120     {
2121         return fail($err,203,'xmlrpc.des.bad_value',{'param'=>'hour'});
2122     }
2123     if ($req->{'min'} !~ /^\d{1,2}$/ ||
2124         $req->{'min'} < 0 || $req->{'min'} > 59)
2125     {
2126         return fail($err,203,'xmlrpc.des.bad_value',{'param'=>'minute'});
2127     }
2128
2129     # column width
2130     # we only trim Unicode data
2131
2132     if ($req->{'ver'} >=1 ) {
2133         $req->{'subject'} = LJ::text_trim($req->{'subject'}, LJ::BMAX_SUBJECT, LJ::CMAX_SUBJECT);
2134         $req->{'event'} = LJ::text_trim($req->{'event'}, LJ::BMAX_EVENT, LJ::CMAX_EVENT);
2135         foreach (keys %{$req->{'props'}}) {
2136             # do not trim this property, as it's magical and handled later
2137             next if $_ eq 'taglist';
2138
2139             # Allow syn_links and syn_ids the full width of the prop, to avoid truncating long URLS
2140             if ($_ eq 'syn_link' || $_ eq 'syn_id') {
2141                 $req->{'props'}->{$_} = LJ::text_trim($req->{'props'}->{$_}, LJ::BMAX_PROP);
2142             } elsif ( $_ eq 'current_music' ) {
2143                 $req->{'props'}->{$_} = LJ::text_trim($req->{'props'}->{$_}, LJ::CMMAX_PROP);
2144             } else {
2145                 $req->{'props'}->{$_} = LJ::text_trim($req->{'props'}->{$_}, LJ::BMAX_PROP, LJ::CMAX_PROP);
2146             }
2147
2148         }
2149     }
2150
2151     # setup non-user meta-data.  it's important we define this here to
2152     # 0.  if it's not defined at all, then an editevent where a user
2153     # removes random 8bit data won't remove the metadata.  not that
2154     # that matters much.  but having this here won't hurt.  false
2155     # meta-data isn't saved anyway.  so the only point of this next
2156     # line is making the metadata be deleted on edit.
2157     $req->{'props'}->{'unknown8bit'} = 0;
2158
2159     # we don't want attackers sending something that looks like gzipped data
2160     # in protocol version 0 (unknown8bit allowed), otherwise they might
2161     # inject a 100MB string of single letters in a few bytes.
2162     return fail($err,208,'xmlrpc.des.send_gzip_fail')
2163         if substr($req->{'event'},0,2) eq "\037\213";
2164
2165     # non-ASCII?
2166     unless ( $flags->{'use_old_content'} || (
2167         LJ::is_ascii($req->{'event'}) &&
2168         LJ::is_ascii($req->{'subject'}) &&
2169         LJ::is_ascii(join(' ', values %{$req->{'props'}})) ))
2170     {
2171
2172         if ($req->{'ver'} < 1) { # client doesn't support Unicode
2173             ## Hack: some old clients do send valid UTF-8 data,
2174             ## but don't tell us about that.
2175             ## Check, if the event/subject are valid UTF-8 strings.
2176             my $tmp_event   = $req->{'event'};
2177             my $tmp_subject = $req->{'subject'};
2178             Encode::from_to($tmp_event,     "utf-8", "utf-8");
2179             Encode::from_to($tmp_subject,   "utf-8", "utf-8");
2180             if ($tmp_event eq $req->{'event'} && $tmp_subject eq $req->{'subject'}) {
2181                 ## ok, this looks like valid UTF-8
2182             } else {
2183                 ## encoding is unknown - it's neither ASCII nor UTF-8
2184                 # only people should have unknown8bit entries.
2185                 my $uowner = $flags->{u_owner} || $flags->{u};
2186                 return fail($err,207,'xmlrpc.des.need_unicode_client')
2187                     if $uowner->{journaltype} ne 'P';
2188
2189                 # so rest of site can change chars to ? marks until
2190                 # default user's encoding is set.  (legacy support)
2191                 $req->{'props'}->{'unknown8bit'} = 1;
2192             }
2193         } else {
2194             return fail($err,207, 'xmlrpc.des.not_unicode') unless $LJ::UNICODE;
2195             # validate that the text is valid UTF-8
2196             if (!LJ::text_in($req->{'subject'}) ||
2197                 !LJ::text_in($req->{'event'}) ||
2198                 grep { !LJ::text_in($_) } values %{$req->{'props'}}) {
2199                 return fail($err, 208, 'xmlrpc.des.not_valid_unicode');
2200             }
2201         }
2202     }
2203
2204     ## handle meta-data (properties)
2205     LJ::load_props("log");
2206     foreach my $pname (keys %{$req->{'props'}})
2207     {
2208         my $p = LJ::get_prop("log", $pname);
2209
2210         # does the property even exist?
2211         unless ($p) {
2212             $pname =~ s/[^\w]//g;
2213             return fail($err,205,$pname);
2214         }
2215
2216         # don't validate its type if it's 0 or undef (deleting)
2217         next unless ($req->{'props'}->{$pname});
2218
2219         my $ptype = $p->{'datatype'};
2220         my $val = $req->{'props'}->{$pname};
2221
2222         if ($ptype eq "bool" && $val !~ /^[01]$/) {
2223             return fail($err,204,'xmlrpc.des.non_boolean',{'param'=>$pname});
2224         }
2225         if ($ptype eq "num" && $val =~ /[^\d]/) {
2226             return fail($err,204,'xmlrpc.des.non_arifmetic',{'param'=>$pname,'value'=>$val});
2227         }
2228         if ($pname eq "current_coords" && ! eval { LJ::Location->new(coords => $val) }) {
2229             return fail($err,204,'xmlrpc.des.bad_value', {'param'=>'current_coords'});
2230         }
2231     }
2232
2233     # check props for inactive userpic
2234     if (my $pickwd = $req->{'props'}->{'picture_keyword'}) {
2235         my $pic = LJ::get_pic_from_keyword($flags->{'u'}, $pickwd);
2236
2237         # need to make sure they aren't trying to post with an inactive keyword, but also
2238         # we don't want to allow them to post with a keyword that has no pic at all to prevent
2239         # them from deleting the keyword, posting, then adding it back with editpics.bml
2240         delete $req->{'props'}->{'picture_keyword'} if ! $pic || $pic->{'state'} eq 'I';
2241     }
2242
2243     # validate incoming list of tags
2244     return fail($err, 211)
2245         if $req->{props}->{taglist} &&
2246            ! LJ::Tags::is_valid_tagstring($req->{props}->{taglist});
2247
2248     return 1;
2249 }
2250
2251 sub postevent {
2252     my ($req, $err, $flags) = @_;
2253     un_utf8_request($req);
2254
2255     my $post_noauth = LJ::run_hook('post_noauth', $req);
2256
2257     return undef unless $post_noauth || authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'postevent');
2258     my $spam = 0;
2259     LJ::run_hook('spam_detector', $req, \$spam);
2260     return fail($err,320) if $spam;
2261
2262     # if going through mod queue, then we know they're permitted to post at least this entry
2263     $flags->{'usejournal_okay'} = 1 if $post_noauth;
2264     return undef unless check_altusage($req, $err, $flags) || $flags->{nomod};
2265
2266     my $u = $flags->{'u'};
2267     my $ownerid = $flags->{'ownerid'}+0;
2268     my $uowner = $flags->{'u_owner'} || $u;
2269     # Make sure we have a real user object here
2270     $uowner = LJ::want_user($uowner) unless LJ::isu($uowner);
2271     r($uowner) unless LJ::isu($uowner);
2272     my $clusterid = $uowner->{'clusterid'};
2273
2274     my $dbh = LJ::get_db_writer();
2275     my $dbcm = LJ::get_cluster_master($uowner);
2276
2277     return fail($err,306) unless $dbh && $dbcm && $uowner->writer;
2278     return fail($err,200) unless $req->{'event'} =~ /\S/;
2279
2280     ### make sure community, shared, or news journals don't post
2281     ### note: shared and news journals are deprecated.  every shared journal
2282     ##        should one day be a community journal, of some form.
2283     return fail($err,150) if ($u->{'journaltype'} eq "C" ||
2284                               $u->{'journaltype'} eq "S" ||
2285                               $u->{'journaltype'} eq "N");
2286
2287     # identity users can only post to communities
2288     return fail( $err, 150 )
2289         if $u->is_identity and LJ::u_equals( $u, $uowner );
2290
2291     # underage users can't do this
2292     return fail($err,310) if $u->underage;
2293
2294     # suspended users can't post
2295     return fail($err,305) if ($u->{'statusvis'} eq "S");
2296
2297     # memorials can't post
2298     return fail($err,309) if $u->{statusvis} eq 'M';
2299
2300     # locked accounts can't post
2301     return fail($err,308) if $u->{statusvis} eq 'L';
2302
2303     # check the journal's read-only bit
2304     return fail($err,306) if LJ::get_cap($uowner, "readonly");
2305
2306     # is the user allowed to post?
2307     return fail($err,404,$LJ::MSG_NO_POST) unless LJ::get_cap($u, "can_post");
2308
2309     # is the user allowed to post?
2310     return fail($err,410) if LJ::get_cap($u, "disable_can_post");
2311
2312     # read-only accounts can't post
2313     return fail($err,316) if $u->is_readonly;
2314
2315     # read-only accounts can't be posted to
2316     return fail($err,317) if $uowner->is_readonly;
2317
2318     # can't post to deleted/suspended community
2319     return fail($err,307) unless $uowner->{'statusvis'} eq "V";
2320
2321     # user must have a validated email address to post to any journal - including its own,
2322     # except syndicated (rss, 'Y') journals
2323     # unless this is approved from the mod queue (we'll error out initially, but in case they change later)
2324     return fail($err, 155, LJ::Lang::ml('event.post.error.not_validated_email'))
2325         unless $flags->{'first_post'} || $u->{'status'} eq 'A' || $u->{'journaltype'} eq 'Y';
2326
2327     $req->{'event'} =~ s/\r\n/\n/g; # compact new-line endings to more comfort chars count near 65535 limit
2328
2329     # post content too large
2330     # NOTE: requires $req->{event} be binary data, but we've already
2331     # removed the utf-8 flag in the XML-RPC path, and it never gets
2332     # set in the "flat" protocol path.
2333     return fail($err,409) if length($req->{'event'}) >= LJ::BMAX_EVENT;
2334
2335     my $time_was_faked = 0;
2336     my $offset = 0;  # assume gmt at first.
2337
2338     if (defined $req->{'tz'}) {
2339         if ($req->{tz} eq 'guess') {
2340             LJ::get_timezone($u, \$offset, \$time_was_faked);
2341         } elsif ($req->{'tz'} =~ /^[+\-]\d\d\d\d$/) {
2342             # FIXME we ought to store this timezone and make use of it somehow.
2343             $offset = $req->{'tz'} / 100.0;
2344         } else {
2345             return fail($err, 203, 'xmlrpc.des.bad_value', {'param'=>'tz'});
2346         }
2347     }
2348
2349     if (defined $req->{'tz'} and not grep { defined $req->{$_} } qw(year mon day hour min)) {
2350         my @ltime = gmtime(time() + ($offset*3600));
2351         $req->{'year'} = $ltime[5]+1900;
2352         $req->{'mon'}  = $ltime[4]+1;
2353         $req->{'day'}  = $ltime[3];
2354         $req->{'hour'} = $ltime[2];
2355         $req->{'min'}  = $ltime[1];
2356         $time_was_faked = 1;
2357     }
2358
2359     return undef
2360         unless common_event_validation($req, $err, $flags);
2361
2362     # confirm we can add tags, at least
2363     return fail($err, 312)
2364         if $req->{props} && $req->{props}->{taglist} &&
2365            ! LJ::Tags::can_add_tags($uowner, $u);
2366
2367     my $event = $req->{'event'};
2368
2369     if ($uowner->is_community) {
2370         delete $req->{'props'}->{'opt_backdated'};
2371     }
2372
2373     ### allow for posting to journals that aren't yours (if you have permission)
2374     my $posterid = $u->{'userid'}+0;
2375
2376     # make the proper date format
2377     my $eventtime = sprintf("%04d-%02d-%02d %02d:%02d",
2378                                 $req->{'year'}, $req->{'mon'},
2379                                 $req->{'day'}, $req->{'hour'},
2380                                 $req->{'min'});
2381     my $qeventtime = $dbh->quote($eventtime);
2382
2383     # load userprops all at once
2384     my @poster_props = qw(newesteventtime);
2385     my @owner_props = qw(newpost_minsecurity moderated);
2386     push @owner_props, 'opt_weblogscom' unless $req->{'props'}->{'opt_backdated'};
2387
2388     LJ::load_user_props($u, @poster_props, @owner_props);
2389     if ($uowner->{'userid'} == $u->{'userid'}) {
2390         $uowner->{$_} = $u->{$_} foreach (@owner_props);
2391     } else {
2392         LJ::load_user_props($uowner, @owner_props);
2393     }
2394
2395     # are they trying to post back in time?
2396     if ($posterid == $ownerid && $u->{'journaltype'} ne 'Y' &&
2397         !LJ::is_enabled("delayed_entries") &&
2398         !$time_was_faked && $u->{'newesteventtime'} &&
2399         $eventtime lt $u->{'newesteventtime'} &&
2400         !$req->{'props'}->{'opt_backdated'}) {
2401         return fail($err, 153, 'xmlrpc.des.entry_time_conflict', {'newesteventtime'=>$u->{'newesteventtime'}});
2402     }
2403
2404     if ( $req->{sticky} &&
2405          $uowner->is_community() &&
2406          !$u->can_manage($uowner) )
2407     {
2408         return fail($err, 158);
2409     }
2410
2411     my $qallowmask = $req->{'allowmask'}+0;
2412     my $security = "public";
2413     my $uselogsec = 0;
2414     if ($req->{'security'} eq "usemask" || $req->{'security'} eq "private") {
2415         $security = $req->{'security'};
2416     }
2417     if ($req->{'security'} eq "usemask") {
2418         $uselogsec = 1;
2419     }
2420
2421     # can't specify both a custom security and 'friends-only'
2422     return fail($err, 203, 'xmlrpc.des.friends_security')
2423         if $qallowmask > 1 && $qallowmask % 2;
2424
2425     ## if newpost_minsecurity is set, new entries have to be
2426     ## a minimum security level
2427     unless ($flags->{'entryrepost'}) {
2428         $security = "private"
2429             if $uowner->newpost_minsecurity eq "private";
2430         ($security, $qallowmask) = ("usemask", 1)
2431             if $uowner->newpost_minsecurity eq "friends"
2432             and $security eq "public";
2433     }
2434
2435     my $qsecurity = $dbh->quote($security);
2436
2437     ### make sure user can't post with "custom/private security" on shared journals
2438     return fail($err,102)
2439         if ($ownerid != $posterid && # community post
2440             ($req->{'security'} eq "private" ||
2441             ($req->{'security'} eq "usemask" && $qallowmask != 1 && !($u->can_manage($uowner)) )));
2442
2443     # make sure this user isn't banned from posting here (if
2444     # this is a community journal)
2445     return fail($err,151) if
2446         LJ::is_banned($posterid, $ownerid);
2447
2448     if (!LJ::is_enabled("delayed_entries")) {
2449         # don't allow backdated posts in communities
2450         return fail($err,152) if
2451                 ($req->{'props'}->{"opt_backdated"} &&
2452                  $uowner->{'journaltype'} ne "P");
2453     }
2454
2455     # do processing of embedded polls (doesn't add to database, just
2456     # does validity checking)
2457     my @polls = ();
2458     if (LJ::Poll->contains_new_poll(\$event))
2459     {
2460         return fail($err,301,'xmlrpc.des.poll_not_permitted')
2461             unless (LJ::get_cap($u, "makepoll")
2462                     || ($uowner->{'journaltype'} eq "C"
2463                         && LJ::get_cap($uowner, "makepoll")
2464                         && LJ::can_manage_other($u, $uowner)));
2465
2466         my $error = "";
2467         @polls = LJ::Poll->new_from_html(\$event, \$error, {
2468             'journalid' => $ownerid,
2469             'posterid' => $posterid,
2470         });
2471         return fail($err,103,$error) if $error;
2472     }
2473
2474     my $repost_offer;
2475     if (LJ::is_enabled("paid_repost")) {
2476         my $error;
2477
2478         $repost_offer = LJ::Pay::Repost::Offer->from_create_entry(
2479             \$event,
2480             {repost_budget => $req->{'repost_budget'},
2481              limit_sc      => $req->{'repost_limit_sc'},
2482              journalid     => $ownerid,
2483              userid        => $posterid},
2484             \$error
2485         );
2486
2487         return fail($err,222) if $repost_offer && ! $flags->{noauth};
2488
2489         return fail($err,160,$error) if $error;
2490     }
2491
2492     # convert RTE lj-embeds to normal lj-embeds
2493     $event = LJ::EmbedModule->transform_rte_post($event);
2494
2495     # process module embedding
2496     LJ::EmbedModule->parse_module_embed($uowner, \$event);
2497
2498     my $now = $dbcm->selectrow_array("SELECT UNIX_TIMESTAMP()");
2499     my $anum  = int(rand(256));
2500
2501     # by default we record the true reverse time that the item was entered.
2502     # however, if backdate is on, we put the reverse time at the end of time
2503     # (which makes it equivalent to 1969, but get_recent_items will never load
2504     # it... where clause there is: < $LJ::EndOfTime).  but this way we can
2505     # have entries that don't show up on friends view, now that we don't have
2506     # the hints table to not insert into.
2507     my $rlogtime = $LJ::EndOfTime;
2508     unless ($req->{'props'}->{'opt_backdated'}) {
2509         $rlogtime -= $now;
2510     }
2511
2512     my $dupsig = Digest::MD5::md5_hex(join('', map { $req->{$_} }
2513                                            qw(subject event usejournal security allowmask)));
2514     my $lock_key = "post-$ownerid";
2515
2516     # release our duplicate lock
2517     my $release = sub {  $dbcm->do("SELECT RELEASE_LOCK(?)", undef, $lock_key); };
2518
2519     # our own local version of fail that releases our lock first
2520     my $fail = sub { $release->(); return fail(@_); };
2521
2522     my $res = {};
2523     my $res_done = 0;  # set true by getlock when post was duplicate, or error getting lock
2524
2525     my $getlock = sub {
2526         my ($delayed) = @_;
2527         my $r = $dbcm->selectrow_array("SELECT GET_LOCK(?, 2)", undef, $lock_key);
2528         unless ($r) {
2529             $res = undef;    # a failure case has an undef result
2530             fail($err,503);  # set error flag to "can't get lock";
2531             $res_done = 1;   # tell caller to bail out
2532             return;
2533         }
2534
2535         if ($delayed) {
2536             my $entry = LJ::DelayedEntry->dupsig_check($uowner, $posterid, $req);
2537             if ($entry) {
2538                 $res->{'delayedid'} = $entry->delayedid;
2539                 $res->{'type'}      = 'delayed';
2540                 $res->{'url'}       = $entry->url;
2541
2542                 $res_done = 1;
2543                 $release->();
2544             }
2545             return;
2546         }
2547
2548         LJ::load_user_props($u, { use_master => 1, reload => 1 }, 'dupsig_post');
2549
2550         my @parts = split(/:/, $u->{'dupsig_post'});
2551         if ($parts[0] eq $dupsig) {
2552             # duplicate!  let's make the client think this was just the
2553             # normal firsit response.
2554
2555             $res->{'itemid'} = $parts[1];
2556             $res->{'anum'} = $parts[2];
2557
2558             my $dup_entry = LJ::Entry->new($uowner, jitemid => $res->{'itemid'}, anum => $res->{'anum'});
2559             $res->{'url'} = $dup_entry->url;
2560
2561             $res_done = 1;
2562             $release->();
2563         }
2564     };
2565
2566     # LJSUP-9616
2567     if ($req->{'props'}->{'opt_backdated'}) {
2568         my $state_date = POSIX::strftime("%Y-%m-%d", gmtime);
2569         my $key = "stat:opt_backdated:$state_date";
2570
2571         LJ::MemCache::incr($key, 1) ||
2572             (LJ::MemCache::add($key, 0),  LJ::MemCache::incr($key, 1));
2573
2574         my $poster_offset = $u->timezone;
2575         my @ltime = gmtime(time() + $poster_offset * 3600);
2576         my $current = sprintf("%04d-%02d-%02d %02d:%02d",
2577                                  $ltime[5]+1900,
2578                                  $ltime[4] + 1,
2579                                  $ltime[3],
2580                                  $ltime[2],
2581                                  $ltime[1]);
2582         if ($eventtime gt $current) {
2583             my $key_future = "stat:opt_backdated:future:$state_date";
2584             LJ::MemCache::incr($key_future, 1) ||
2585                 (LJ::MemCache::add($key_future, 0),  LJ::MemCache::incr($key_future, 1));
2586         }
2587     }
2588
2589     if ( $req->{ver} > 3 && LJ::is_enabled("delayed_entries") ) {
2590         if ( $req->{'custom_time'} && LJ::DelayedEntry::is_future_date($req) ) {
2591             return fail($err, 215) unless $req->{tz};
2592
2593             return fail($err, 159) if $repost_offer;
2594
2595             # if posting to a moderated community, store and bail out here
2596             if ( !LJ::DelayedEntry::can_post_to($uowner, $u, $req)) {
2597                 return fail($err, 322);
2598             }
2599
2600             $req->{ext}->{flags} = $flags;
2601             $req->{usejournal} = $req->{usejournal} || '';
2602             delete $req->{'custom_time'};
2603
2604             $getlock->('delayed');
2605             return $res if $res_done;
2606
2607             my $entry = LJ::DelayedEntry->create( $req, { journal => $uowner,
2608                                                           poster  => $u,} );
2609             if (!$entry) {
2610                 return $fail->($err, 507);
2611             }
2612
2613             $res->{'delayedid'} = $entry->delayedid;
2614             $res->{'type'}      = 'delayed';
2615             $res->{'url'}       = $entry->url;
2616
2617             $release->();
2618             return $res;
2619         }
2620         else {
2621             $res->{type} = 'posted';
2622         }
2623     }
2624
2625     my $need_moderated = ( $uowner->{'moderated'} =~ /^[1A]$/ ) ? 1 : 0;
2626     if ( $uowner->{'moderated'} eq 'F' ) {
2627         ## Scan post for spam
2628         LJ::run_hook('spam_community_detector', $uowner, $req, \$need_moderated);
2629     }
2630
2631     # if posting to a moderated community, store and bail out here
2632     if ($uowner->{'journaltype'} eq 'C' && $need_moderated && !$flags->{'nomod'}) {
2633         # don't moderate admins, moderators & pre-approved users
2634         my $dbh = LJ::get_db_writer();
2635         my $relcount = $dbh->selectrow_array("SELECT COUNT(*) FROM reluser ".
2636                                              "WHERE userid=$ownerid AND targetid=$posterid ".
2637                                              "AND type IN ('A','M','N')");
2638         unless ($relcount) {
2639             # moderation queue full?
2640             my $modcount = $dbcm->selectrow_array("SELECT COUNT(*) FROM modlog WHERE journalid=$ownerid");
2641             return fail($err, 407) if $modcount >= LJ::get_cap($uowner, "mod_queue");
2642
2643             $modcount = $dbcm->selectrow_array("SELECT COUNT(*) FROM modlog ".
2644                                                "WHERE journalid=$ownerid AND posterid=$posterid");
2645             return fail($err, 408) if $modcount >= LJ::get_cap($uowner, "mod_queue_per_poster");
2646
2647             $req->{'_moderate'}->{'authcode'} = LJ::make_auth_code(15);
2648
2649             # create tag <lj-embed> from HTML-tag <embed>
2650             LJ::EmbedModule->parse_module_embed($uowner, \$req->{event});
2651
2652             my $fr = $dbcm->quote(Storable::nfreeze($req));
2653             return fail($err, 409) if length($fr) > 200_000;
2654
2655             # store
2656             my $modid = LJ::alloc_user_counter($uowner, "M");
2657             return fail($err, 501) unless $modid;
2658
2659             $uowner->do("INSERT INTO modlog (journalid, modid, posterid, subject, logtime) ".
2660                         "VALUES ($ownerid, $modid, $posterid, ?, NOW())", undef,
2661                         LJ::text_trim($req->{'subject'}, 30, 0));
2662             return fail($err, 501) if $uowner->err;
2663
2664             $uowner->do("INSERT INTO modblob (journalid, modid, request_stor) ".
2665                         "VALUES ($ownerid, $modid, $fr)");
2666             if ($uowner->err) {
2667                 $uowner->do("DELETE FROM modlog WHERE journalid=$ownerid AND modid=$modid");
2668                 return fail($err, 501);
2669             }
2670
2671             # alert moderator(s), maintainers, owner
2672             my $mods        = LJ::load_rel_user($dbh, $ownerid, 'M') || [];
2673             my $mains       = LJ::load_rel_user($dbh, $ownerid, 'A') || [];
2674             my $super       = LJ::load_rel_user($dbh, $ownerid, 'S') || [];
2675             my %mail_list   = (map { $_ => 1 } (@$super, @$mods, @$mains));
2676
2677             if (%mail_list) {
2678                 # load up all these mods and figure out if they want email or not
2679                 my $modlist = LJ::load_userids(keys %mail_list);
2680
2681                 my @emails;
2682                 my $ct;
2683                 foreach my $mod (values %$modlist) {
2684                     last if $ct > 20;  # don't send more than 20 emails.
2685
2686                     next unless $mod->is_visible;
2687
2688                     LJ::load_user_props($mod, 'opt_nomodemail');
2689                     next if $mod->{opt_nomodemail};
2690                     next if $mod->{status} ne "A";
2691
2692                     push @emails,
2693                         {
2694                             to          => $mod->email_raw,
2695                             browselang  => $mod->prop('browselang'),
2696                             charset     => $mod->mailencoding || 'utf-8',
2697                         };
2698
2699                     ++$ct;
2700                 }
2701
2702                 foreach my $to (@emails) {
2703                     # TODO: html/plain text.
2704                     my $body = LJ::Lang::get_text(
2705                         $to->{'browselang'},
2706                         'esn.moderated_submission.body', undef,
2707                         {
2708                             user        => $u->{'user'},
2709                             subject     => $req->{'subject'},
2710                             community   => $uowner->{'user'},
2711                             modid       => $modid,
2712                             siteroot    => $LJ::SITEROOT,
2713                             sitename    => $LJ::SITENAME,
2714                             moderateurl => "$LJ::SITEROOT/community/moderate.bml?authas=$uowner->{'user'}&modid=$modid",
2715                             viewurl     => "$LJ::SITEROOT/community/moderate.bml?authas=$uowner->{'user'}",
2716                         });
2717
2718                     my $subject = LJ::Lang::get_text($to->{'browselang'},'esn.moderated_submission.subject');
2719
2720                     LJ::send_mail({
2721                         'to'        => $to->{to},
2722                         'from'      => $LJ::DONOTREPLY_EMAIL,
2723                         'charset'   => $to->{charset},
2724                         'subject'   => $subject,
2725                         'body'      => $body,
2726                     });
2727                 }
2728             }
2729
2730             my $msg = translate($u, "modpost", undef);
2731             return {
2732                 'message' => $msg,
2733                 xc3 => {
2734                     u => $u,
2735                     post => {
2736                         coords      => $req->{props}->{current_coords},
2737                         has_images  => ($req->{event} =~ /pics\.livejournal\.com/ ? 1 : 0),
2738                         from_mobile => ($req->{event} =~ /m\.livejournal\.com/ ? 1 : 0)
2739                     }
2740                 }
2741             };
2742         }
2743     } # /moderated comms
2744
2745     # posting:
2746
2747     $getlock->();
2748
2749     return $res if $res_done;
2750
2751     # do rate-checking
2752     if ($u->{'journaltype'} ne "Y" && ! LJ::rate_log($u, "post", 1)) {
2753         return $fail->($err,405);
2754     }
2755
2756     my $jitemid = LJ::alloc_user_counter($uowner, "L");
2757     return $fail->($err,501,'xmlrpc.des.cannnot_generate_items') unless $jitemid;
2758
2759     # bring in LJ::Entry with Class::Autouse
2760     LJ::Entry->can("dostuff");
2761     LJ::replycount_do($uowner, $jitemid, "init");
2762
2763     # remove comments and logprops on new entry ... see comment by this sub for clarification
2764     LJ::Protocol::new_entry_cleanup_hack($u, $jitemid) if $LJ::NEW_ENTRY_CLEANUP_HACK;
2765     my $verb = $LJ::NEW_ENTRY_CLEANUP_HACK ? 'REPLACE' : 'INSERT';
2766
2767     my $dberr;
2768     $uowner->log2_do(\$dberr, "INSERT INTO log2 (journalid, jitemid, posterid, eventtime, logtime, security, ".
2769                      "allowmask, replycount, year, month, day, revttime, rlogtime, anum) ".
2770                      "VALUES ($ownerid, $jitemid, $posterid, $qeventtime, FROM_UNIXTIME($now), $qsecurity, $qallowmask, ".
2771                      "0, $req->{'year'}, $req->{'mon'}, $req->{'day'}, $LJ::EndOfTime-".
2772                      "UNIX_TIMESTAMP($qeventtime), $rlogtime, $anum)");
2773     return $fail->($err,501,$dberr) if $dberr;
2774
2775     # post become 'sticky post'
2776     if ( $req->{sticky} ) {
2777         $uowner->set_sticky_id($jitemid);
2778         my $state_date = POSIX::strftime("%Y-%m-%d", gmtime);
2779
2780         my $postfix = '';
2781         if ($uowner->is_community) {
2782            $postfix = '_community';
2783         }
2784
2785         my $sticky_entry = "stat:sticky$postfix:$state_date";
2786         LJ::MemCache::incr($sticky_entry, 1) ||
2787             (LJ::MemCache::add($sticky_entry, 0),  LJ::MemCache::incr($sticky_entry, 1));
2788     }
2789
2790     LJ::MemCache::incr([$ownerid, "log2ct:$ownerid"]);
2791
2792     # set userprops.
2793     {
2794         my %set_userprop;
2795
2796         # keep track of itemid/anum for later potential duplicates
2797         $set_userprop{"dupsig_post"} = "$dupsig:$jitemid:$anum";
2798
2799         # record the eventtime of the last update (for own journals only)
2800         $set_userprop{"newesteventtime"} = $eventtime
2801             if $posterid == $ownerid and not $req->{'props'}->{'opt_backdated'} and not $time_was_faked;
2802
2803         $u->set_prop(\%set_userprop);
2804     }
2805
2806     # end duplicate locking section
2807     $release->();
2808
2809     my $ditemid = $jitemid * 256 + $anum;
2810
2811     ### finish embedding stuff now that we have the itemid
2812     {
2813         ### this should NOT return an error, and we're mildly fucked by now
2814         ### if it does (would have to delete the log row up there), so we're
2815         ### not going to check it for now.
2816
2817         my $error = "";
2818         foreach my $poll (@polls) {
2819             $poll->save_to_db(
2820                               journalid => $ownerid,
2821                               posterid  => $posterid,
2822                               ditemid   => $ditemid,
2823                               error     => \$error,
2824                               );
2825
2826             my $pollid = $poll->pollid;
2827
2828             $event =~ s/<lj-poll-placeholder>/<lj-poll-$pollid>/;
2829         }
2830     }
2831     #### /embedding
2832
2833     # record journal's disk usage
2834     my $bytes = length($event) + length($req->{'subject'});
2835     $uowner->dudata_set('L', $jitemid, $bytes);
2836
2837     $uowner->do("$verb INTO logtext2 (journalid, jitemid, subject, event) ".
2838                 "VALUES ($ownerid, $jitemid, ?, ?)", undef, $req->{'subject'},
2839                 LJ::text_compress($event));
2840     if ($uowner->err) {
2841         my $msg = $uowner->errstr;
2842         LJ::delete_entry($uowner, $jitemid, undef, $anum);   # roll-back
2843         return fail($err,501,"logtext:$msg");
2844     }
2845     LJ::MemCache::set([$ownerid,"logtext:$clusterid:$ownerid:$jitemid"],
2846                       [ $req->{'subject'}, $event ]);
2847
2848     # keep track of custom security stuff in other table.
2849     if ($uselogsec) {
2850         $uowner->do("INSERT INTO logsec2 (journalid, jitemid, allowmask) ".
2851                     "VALUES ($ownerid, $jitemid, $qallowmask)");
2852         if ($uowner->err) {
2853             my $msg = $uowner->errstr;
2854             LJ::delete_entry($uowner, $jitemid, undef, $anum);   # roll-back
2855             return fail($err,501,"logsec2:$msg");
2856         }
2857     }
2858
2859     # Entry tags
2860     if ($req->{props} && defined $req->{props}->{taglist}) {
2861         # slightly misnamed, the taglist is/was normally a string, but now can also be an arrayref.
2862         my $taginput = $req->{props}->{taglist};
2863
2864         my $logtag_opts = {
2865             remote => $u,
2866             skipped_tags => [], # do all possible and report impossible
2867         };
2868
2869         if (ref $taginput eq 'ARRAY') {
2870             $logtag_opts->{set} = [@$taginput];
2871             $req->{props}->{taglist} = join(", ", @$taginput);
2872         } else {
2873             $logtag_opts->{set_string} = $taginput;
2874         }
2875
2876         my $rv = LJ::Tags::update_logtags($uowner, $jitemid, $logtag_opts);
2877         push @{$res->{warnings} ||= []}, LJ::Lang::ml('/update.bml.tags.skipped', { 'tags' => join(', ', @{$logtag_opts->{skipped_tags}}),
2878                                                              'limit' => $uowner->get_cap('tags_max') } )
2879             if @{$logtag_opts->{skipped_tags}};
2880     }
2881
2882     ## copyright
2883     if (LJ::is_enabled('default_copyright', $u)) {
2884         $req->{'props'}->{'copyright'} = $u->prop('default_copyright')
2885             unless defined $req->{'props'}->{'copyright'};
2886         $req->{'props'}->{'copyright'} = 'P' # second try
2887             unless defined $req->{'props'}->{'copyright'};
2888     } else {
2889         delete $req->{'props'}->{'copyright'};
2890     }
2891
2892     ## give features
2893     if (LJ::is_enabled('give_features')) {
2894         $req->{'props'}->{'give_features'} = ($req->{'props'}->{'give_features'} eq 'enable') ? 1 :
2895                                              ($req->{'props'}->{'give_features'} eq 'disable') ? 0 :
2896                                              1; # LJSUP-9142: All users should be able to use give button
2897     }
2898
2899     my $entry = LJ::Entry->new($uowner, jitemid => $jitemid, anum => $anum);
2900
2901     # meta-data
2902     if (%{$req->{'props'}}) {
2903         my $propset = {};
2904
2905         foreach my $pname (keys %{$req->{'props'}}) {
2906             next unless $req->{'props'}->{$pname};
2907             next if $pname eq "revnum" || $pname eq "revtime";
2908             my $p = LJ::get_prop("log", $pname);
2909             next unless $p;
2910             next unless $req->{'props'}->{$pname};
2911             $propset->{$pname} = $req->{'props'}->{$pname};
2912         }
2913
2914         my %logprops;
2915         $entry->set_prop_multi( $propset, \%logprops );
2916
2917         for my $key ( keys %logprops ) {
2918             next if $key =~ /^\d+$/;
2919
2920             unless ( $LJ::CACHE_PROP{'log'}->{$key}->{'propid'} ) {
2921                 delete $logprops{$key};
2922             }
2923             else {
2924                 $logprops{ $LJ::CACHE_PROP{'log'}->{$key}->{'propid'} } = delete $logprops{$key};
2925             }
2926         }
2927
2928         # if set_prop_multi modified props above, we can set the memcache key
2929         # to be the hashref of modified props, since this is a new post
2930         LJ::MemCache::set([$uowner->{'userid'}, "logprop2:$uowner->{'userid'}:$jitemid"],
2931                           \%logprops) if %logprops;
2932     }
2933
2934     # Paid Repost Offer
2935     if ($repost_offer) {
2936         my $error = '';
2937
2938         $repost_offer->{jitemid} = $jitemid;
2939
2940         my $offer_id = LJ::Pay::Repost::Offer->create(
2941             \$error,
2942             %$repost_offer,
2943         );
2944
2945         unless ( $offer_id ) {
2946             LJ::delete_entry($uowner, $jitemid, undef, $anum); # roll-back
2947             return fail($err,160,$error);
2948         }
2949     }
2950
2951     $dbh->do("UPDATE userusage SET timeupdate=NOW(), lastitemid=$jitemid ".
2952              "WHERE userid=$ownerid") unless $flags->{'notimeupdate'};
2953     LJ::MemCache::set([$ownerid, "tu:$ownerid"], pack("N", time()), 30*60);
2954
2955     # argh, this is all too ugly.  need to unify more postpost stuff into async
2956     $u->invalidate_directory_record;
2957
2958     # note this post in recentactions table
2959     LJ::note_recent_action($uowner, 'post');
2960
2961     # if the post was public, and the user has not opted out, try to insert into the random table;
2962     # note we do INSERT INGORE since there will be lots of people posting every second, and that's
2963     # the granularity we use
2964     if ($security eq 'public' && LJ::u_equals($u, $uowner) && ! $u->prop('latest_optout')) {
2965         $u->do("INSERT IGNORE INTO random_user_set (posttime, userid) VALUES (UNIX_TIMESTAMP(), ?)",
2966                undef, $u->{userid});
2967     }
2968
2969     my @jobs;  # jobs to add into TheSchwartz
2970
2971     # notify weblogs.com of post if necessary
2972     if (!$LJ::DISABLED{'weblogs_com'} &&
2973          $u->{'opt_weblogscom'} &&
2974          LJ::get_cap($u, "weblogscom") &&
2975         $security eq "public" ) {
2976         push @jobs, TheSchwartz::Job->new_from_array("LJ::Worker::Ping::WeblogsCom", {
2977             'user' => $u->{'user'},
2978             'title' => $u->{'journaltitle'} || $u->{'name'},
2979             'url' => LJ::journal_base($u) . "/",
2980         });
2981       }
2982
2983     my $ip = LJ::get_remote_ip();
2984     my $uniq = LJ::UniqCookie->current_uniq();
2985
2986     $u->do('INSERT INTO logleft VALUES (?, NOW(), ?, ?, ?, ?, ?)', undef,
2987         $posterid,
2988         $ownerid,
2989         $ditemid,
2990         $ip,
2991         $uniq,
2992         $security eq 'public'
2993     ) if $uowner->{'journaltype'} eq 'C';
2994
2995     ## Counter "new_post" for monitoring
2996     LJ::run_hook ("update_counter", {
2997         counter => "new_post",
2998     });
2999
3000     # run local site-specific actions
3001     LJ::run_hooks("postpost", {
3002         'itemid'    => $jitemid,
3003         'anum'      => $anum,
3004         'journal'   => $uowner,
3005         'poster'    => $u,
3006         'event'     => $event,
3007         'eventtime' => $eventtime,
3008         'subject'   => $req->{'subject'},
3009         'security'  => $security,
3010         'allowmask' => $qallowmask,
3011         'props'     => $req->{'props'},
3012         'entry'     => $entry,
3013         'jobs'      => \@jobs,  # for hooks to push jobs onto
3014         'req'       => $req,
3015         'res'       => $res,
3016         'entryrepost' => $flags->{'entryrepost'},
3017         'logtime'   => $now,
3018     });
3019
3020     # cluster tracking
3021     LJ::mark_user_active($u, 'post');
3022     LJ::mark_user_active($uowner, 'post') unless LJ::u_equals($u, $uowner);
3023
3024     $res->{'itemid'} = $jitemid;  # by request of mart
3025     $res->{'anum'} = $anum;
3026     $res->{'ditemid'} = $ditemid;
3027     $res->{'url'} = $entry->url;
3028
3029     if ($flags->{'entryrepost'}) {
3030         push @jobs, LJ::Event::JournalNewRepost->new($entry)->fire_job;
3031     } else {
3032         push @jobs, LJ::Event::JournalNewEntry->new($entry)->fire_job;
3033
3034         if (!$LJ::DISABLED{'esn-userevents'} || $LJ::_T_FIRE_USERNEWENTRY) {
3035             push @jobs, LJ::Event::UserNewEntry->new($entry)->fire_job
3036         }
3037     }
3038
3039     push @jobs, LJ::EventLogRecord::NewEntry->new($entry)->fire_job;
3040
3041     # PubSubHubbub Support
3042     LJ::Feed::generate_hubbub_jobs($uowner, \@jobs) unless $uowner->is_syndicated;
3043
3044     my $sclient = LJ::theschwartz();
3045     if ($sclient && @jobs) {
3046         my @handles = $sclient->insert_jobs(@jobs);
3047         # TODO: error on failure?  depends on the job I suppose?  property of the job?
3048     }
3049
3050     $res->{xc3} = {
3051         u => $u,
3052         post => {
3053             url         => $res->{url},
3054             coords      => $req->{props}->{current_coords},
3055             has_images  => ($req->{event} =~ /pics\.livejournal\.com/ ? 1 : 0),
3056             from_mobile => ($req->{event} =~ /m\.livejournal\.com/ ? 1 : 0)
3057         }
3058     };
3059
3060     return $res;
3061 }
3062
3063 sub editevent {
3064     my ($req, $err, $flags) = @_;
3065     un_utf8_request($req);
3066
3067     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'editevent');
3068
3069     my $spam = 0;
3070     return undef unless LJ::run_hook('spam_detector', $req, \$spam);
3071     return fail($err,320) if $spam;
3072
3073     # new rule from 14 march 2011: user is allowed to edit only if he is allowed to do new post
3074     # but is allowed to delete its own post
3075     return undef unless check_altusage($req, $err, $flags) or $req->{'event'} !~ /\S/;
3076
3077     my $u = $flags->{'u'};
3078
3079     # Ownerid - community/blog id
3080     my $ownerid = $flags->{'ownerid'};
3081     my $uowner = $flags->{'u_owner'} || $u;
3082
3083     # Make sure we have a user object here
3084     $uowner = LJ::want_user($uowner) unless LJ::isu($uowner);
3085     my $clusterid = $uowner->{'clusterid'};
3086
3087     # Posterid - the id of the author of the entry
3088     my $posterid = $u->{'userid'};
3089     my $qallowmask = $req->{'allowmask'}+0;
3090     my $sth;
3091
3092     if ($uowner->is_community) {
3093         delete $req->{'props'}->{'opt_backdated'};
3094     }
3095
3096     my $itemid = $req->{'itemid'}+0;
3097
3098     $itemid ||= int( ($req->{'ditemid'} + 0) / 256);
3099
3100     # underage users can't do this
3101     return fail($err,310) if $u->underage;
3102
3103     # check the journal's read-only bit
3104     return fail($err,306) if LJ::get_cap($uowner, "readonly");
3105
3106     # can't edit in deleted/suspended community
3107     return fail($err,307) unless $uowner->{'statusvis'} eq "V" || $uowner->is_readonly;
3108
3109     my $dbh = LJ::get_db_writer();
3110     my $dbcm = LJ::get_cluster_master($uowner);
3111     return fail($err,306) unless $dbcm && $dbh;
3112
3113     # can't specify both a custom security and 'friends-only'
3114     return fail($err, 203, 'xmlrpc.des.friends_security')
3115         if $qallowmask > 1 && $qallowmask % 2;
3116
3117     ### make sure user can't change a post to "custom/private security" on shared journals
3118     return fail($err,102)
3119         if ($ownerid != $posterid && # community post
3120             ($req->{'security'} eq "private" ||
3121             ($req->{'security'} eq "usemask" && $qallowmask != 1 && !($u->can_manage($uowner)) )));
3122
3123     # make sure user can't change post in a certain community without being its member
3124     return fail($err,102)
3125         if ($LJ::JOURNALS_WITH_PROTECTED_CONTENT{ $uowner->{user} } &&
3126             !LJ::is_friend($uowner, $u));
3127
3128     # make sure the new entry's under the char limit
3129     # NOTE: as in postevent, this requires $req->{event} to be binary data
3130     # but we've already removed the utf-8 flag in the XML-RPC path, and it
3131     # never gets set in the "flat" protocol path
3132     return fail($err, 409) if length($req->{event}) >= LJ::BMAX_EVENT;
3133
3134     if ( $req->{ver} > 3 && LJ::is_enabled("delayed_entries") && $req->{delayedid} ) {
3135         my $delayedid = delete $req->{delayedid};
3136         my $res = {};
3137
3138         if ( $delayedid ) {
3139             return fail( $err, 217 ) if $req->{itemid} || $req->{anum};
3140             return fail( $err, 215 ) unless $req->{tz};
3141
3142             if ( $req->{repost_budget} || LJ::CleanHtml::Like->extract_repost_params(\$req->{event}) ) {
3143                 return fail($err, 159);
3144             }
3145
3146             $req->{ext}->{flags} = $flags;
3147             $req->{usejournal} = $req->{usejournal}  || '';
3148
3149             my $entry = LJ::DelayedEntry->get_entry_by_id(
3150                 $uowner,
3151                 $delayedid,
3152                 { userid => $posterid },
3153             );
3154
3155             return fail($err, 508) unless $entry;
3156             if ($req->{'event'} !~ /\S/ ) {
3157                 $entry->delete();
3158                 $res->{delayedid} = $delayedid;
3159
3160                 unless ( $flags->{'noauth'} ) {
3161                     LJ::User::UserlogRecord::DeleteDelayedEntry->create(
3162                         $uowner,
3163                         'remote'    => $u,
3164                         'delayedid' => $delayedid,
3165                         'method'    => 'protocol',
3166                     );
3167                 }
3168
3169                 return $res;
3170             }
3171
3172             # updating an entry:
3173             return undef
3174                 unless common_event_validation($req, $err, $flags);
3175
3176             $entry->update($req);
3177             $res->{type} = 'delayed';
3178             $res->{delayedid} = $delayedid;
3179         }
3180
3181         return $res if $res->{type};
3182     }
3183
3184     if ( $req->{sticky} &&
3185          $uowner->is_community() &&
3186          !$u->can_manage($uowner) )
3187     {
3188         return fail($err, 158);
3189     }
3190
3191     # don't moderate admins, moderators, pre-approved users & unsuspicious users
3192     my $is_unsuspicious_user = 0;
3193     LJ::run_hook('is_unsuspicious_user_in_comm', $posterid, \$is_unsuspicious_user);
3194     my $is_approved_user = LJ::RelationService->is_relation_type_to( $ownerid, $posterid, [ 'A','M','N' ] );
3195     unless ( $is_unsuspicious_user || $is_approved_user || !$uowner->check_non_whitelist_enabled() ) {
3196
3197         my $entry = LJ::Entry->new($ownerid, jitemid => $itemid);
3198         my $modid_old = $entry->prop("mod_queue_id");
3199
3200         my $need_moderated_old = 0;
3201
3202         my $suspicious_list_old = {};
3203         LJ::run_hook('spam_community_detector', $uowner, { event => $entry->event_html }, \$need_moderated_old, $suspicious_list_old);
3204
3205         my $need_moderated = 0;
3206
3207         my $suspicious_list = {};
3208         LJ::run_hook('spam_community_detector', $uowner, $req, \$need_moderated, $suspicious_list);
3209
3210         foreach ( keys %$suspicious_list_old ) {
3211             delete $suspicious_list->{$_};
3212         }
3213         $need_moderated = scalar keys %$suspicious_list;
3214
3215         if ($uowner->{'journaltype'} eq 'C' && !$flags->{'nomod'}) {
3216
3217
3218             if ($need_moderated) {
3219
3220                 $req->{'_moderate'}->{'authcode'} = LJ::make_auth_code(15);
3221
3222                 # create tag <lj-embed> from HTML-tag <embed>
3223                 LJ::EmbedModule->parse_module_embed($uowner, \$req->{event});
3224
3225                 my $fr = $dbcm->quote(Storable::nfreeze($req));
3226                 return fail($err, 409) if length($fr) > 200_000;
3227
3228                 # store
3229                 my $modid = LJ::alloc_user_counter($uowner, "M");
3230                 return fail($err, 501) unless $modid;
3231
3232                 $uowner->do("INSERT INTO modlog (journalid, modid, posterid, subject, logtime) ".
3233                             "VALUES ($ownerid, $modid, $posterid, ?, NOW())", undef,
3234                             LJ::text_trim($req->{'subject'}, 30, 0));
3235                 return fail($err, 501) if $uowner->err;
3236
3237                 $uowner->do("INSERT INTO modblob (journalid, modid, request_stor) ".
3238                             "VALUES ($ownerid, $modid, $fr)");
3239                 if ($uowner->err) {
3240                     $uowner->do("DELETE FROM modlog WHERE journalid=$ownerid AND modid=$modid");
3241                     return fail($err, 501);
3242                 }
3243
3244                 if ($modid_old) {
3245                     $uowner->do("DELETE FROM modlog WHERE journalid=$ownerid AND modid=$modid_old");
3246                     return fail($err, 501) if $uowner->err;
3247                     $uowner->do("DELETE FROM modblob WHERE journalid=$ownerid AND modid=$modid_old");
3248                     return fail($err, 501) if $uowner->err;
3249                 }
3250
3251                 $entry->set_prop("mod_queue_id", $modid);
3252
3253                 my $suspicious_text = "";
3254                 foreach ( sort keys %$suspicious_list ) {
3255                     $suspicious_text .= "   - $suspicious_list->{$_}->{type} - $suspicious_list->{$_}->{url}\n";
3256                 }
3257
3258                 # alert moderator(s), maintainers, owner
3259                 my $mods        = LJ::load_rel_user($dbh, $ownerid, 'M') || [];
3260                 my $mains       = LJ::load_rel_user($dbh, $ownerid, 'A') || [];
3261                 my $super       = LJ::load_rel_user($dbh, $ownerid, 'S') || [];
3262                 my %mail_list   = (map { $_ => 1 } (@$super, @$mods, @$mains));
3263
3264                 if (%mail_list) {
3265                     # load up all these mods and figure out if they want email or not
3266                     my $modlist = LJ::load_userids(keys %mail_list);
3267
3268                     my @emails;
3269                     my $ct;
3270                     foreach my $mod (values %$modlist) {
3271                         last if $ct > 20;  # don't send more than 20 emails.
3272
3273                         next unless $mod->is_visible;
3274
3275                         LJ::load_user_props($mod, 'opt_nomodemail');
3276                         next if $mod->{opt_nomodemail};
3277                         next if $mod->{status} ne "A";
3278
3279                         push @emails,
3280                             {
3281                                 to          => $mod->email_raw,
3282                                 browselang  => $mod->prop('browselang'),
3283                                 charset     => $mod->mailencoding || 'utf-8',
3284                             };
3285
3286                         ++$ct;
3287                     }
3288
3289                     foreach my $to (@emails) {
3290                         # TODO: html/plain text.
3291                         my $body = LJ::Lang::get_text(
3292                             $to->{'browselang'},
3293                             'esn.moderated_edited_submission.body', undef,
3294                             {
3295                                 user        => $u->{'user'},
3296                                 subject     => $req->{'subject'},
3297                                 community   => $uowner->{'user'},
3298                                 modid       => $modid,
3299                                 siteroot    => $LJ::SITEROOT,
3300                                 sitename    => $LJ::SITENAME,
3301                                 moderateurl => "$LJ::SITEROOT/community/moderate.bml?authas=$uowner->{'user'}&modid=$modid",
3302                                 viewurl     => "$LJ::SITEROOT/community/moderate.bml?authas=$uowner->{'user'}",
3303                                 susp_list   => $suspicious_text,
3304                             });
3305
3306                         my $subject = LJ::Lang::get_text($to->{'browselang'},'esn.moderated_edited_submission.subject');
3307
3308                         LJ::send_mail({
3309                             'to'        => $to->{to},
3310                             'from'      => $LJ::DONOTREPLY_EMAIL,
3311                             'charset'   => $to->{charset},
3312                             'subject'   => $subject,
3313                             'body'      => $body,
3314                         });
3315                     }
3316                 }
3317
3318                 my $msg = translate($u, "modpost", undef);
3319                 return {
3320                     'message' => $msg,
3321                     xc3 => {
3322                         u => $u,
3323                         post => {
3324                             coords      => $req->{props}->{current_coords},
3325                             has_images  => ($req->{event} =~ /pics\.livejournal\.com/ ? 1 : 0),
3326                             from_mobile => ($req->{event} =~ /m\.livejournal\.com/ ? 1 : 0)
3327                         }
3328                     }
3329                 };
3330             } elsif ($modid_old) {
3331                 $uowner->do("DELETE FROM modlog  WHERE journalid=? and  modid=?", undef, $ownerid, $modid_old);
3332                 $uowner->do("DELETE FROM modblob WHERE journalid=? and  modid=?", undef, $ownerid, $modid_old);
3333                 $entry->set_prop("mod_queue_id", undef);
3334             }
3335         }
3336     }
3337
3338     # fetch the old entry from master database so we know what we
3339     # really have to update later.  usually people just edit one part,
3340     # not every field in every table.  reads are quicker than writes,
3341     # so this is worth it.
3342     my $oldevent = $dbcm->selectrow_hashref
3343         ("SELECT journalid AS 'ownerid', posterid, eventtime, logtime, ".
3344          "compressed, security, allowmask, year, month, day, ".
3345          "rlogtime, anum FROM log2 WHERE journalid=$ownerid AND jitemid=$itemid");
3346
3347     ($oldevent->{subject}, $oldevent->{event}) = $dbcm->selectrow_array
3348         ("SELECT subject, event FROM logtext2 ".
3349          "WHERE journalid=$ownerid AND jitemid=$itemid");
3350
3351     LJ::text_uncompress(\$oldevent->{'event'});
3352
3353     # use_old_content indicates the subject and entry are not changing
3354     if ($flags->{'use_old_content'}) {
3355         $req->{'event'} = $oldevent->{event};
3356         $req->{'subject'} = $oldevent->{subject};
3357     }
3358
3359     # kill seconds in eventtime, since we don't use it, then we can use 'eq' and such
3360     $oldevent->{'eventtime'} =~ s/:00$//;
3361
3362     ### make sure this user is allowed to edit this entry
3363     return fail($err,302)
3364         unless ($ownerid == $oldevent->{'ownerid'});
3365
3366     ### what can they do to somebody elses entry?  (in shared journal)
3367     ### can edit it if they own or maintain the journal, but not if the journal is read-only
3368     if ($posterid != $oldevent->{'posterid'} || $u->is_readonly || $uowner->is_readonly) {
3369         ## deleting.
3370         return fail($err,304)
3371             if ($req->{'event'} !~ /\S/ && !
3372                 ($ownerid == $u->{'userid'} ||
3373                  # community account can delete it (ick)
3374
3375                  LJ::can_manage_other($posterid, $ownerid)
3376                  # if user is a community maintainer they can delete
3377                  # it too (good)
3378                  ));
3379
3380         ## editing:
3381         if ($req->{'event'} =~ /\S/) {
3382             return fail($err,303) if $posterid != $oldevent->{'posterid'};
3383             return fail($err,318) if $u->is_readonly;
3384             return fail($err,319) if $uowner->is_readonly;
3385         }
3386     }
3387
3388     # simple logic for deleting an entry
3389     if (!$flags->{'use_old_content'} && $req->{'event'} !~ /\S/) {
3390         ## 23.11.2009. Next code added due to some hackers activities
3391         ## that use trojans to delete user's entries in theirs journals.
3392         if ($LJ::DELETING_ENTRIES_IS_DISABLED
3393             && $u->is_person and $u->userid eq $oldevent->{ownerid}
3394         ){
3395             my $qsecurity = $uowner->quote('private');
3396             my $dberr;
3397             LJ::run_hooks('report_entry_update', $ownerid, $itemid);
3398             $uowner->log2_do(\$dberr, "UPDATE log2 SET security=$qsecurity " .
3399                                        "WHERE journalid=$ownerid AND jitemid=$itemid");
3400             return fail($err,501,$dberr) if $dberr;
3401             return fail($err, 321);
3402         }
3403
3404         # if their newesteventtime prop equals the time of the one they're deleting
3405         # then delete their newesteventtime.
3406         if ($u->{'userid'} == $uowner->{'userid'}) {
3407             LJ::load_user_props($u, { use_master => 1 }, "newesteventtime");
3408             if ($u->{'newesteventtime'} eq $oldevent->{'eventtime'}) {
3409                 $u->clear_prop('newesteventtime');
3410             }
3411         }
3412
3413         # log this event, unless noauth is on, which means it is being done internally and we should
3414         # rely on them to log why they're deleting the entry if they need to.  that way we don't have
3415         # double entries, and we have as much information available as possible at the location the
3416         # delete is initiated.
3417         unless ( $flags->{'noauth'} ) {
3418             LJ::User::UserlogRecord::DeleteEntry->create( $uowner,
3419                 'remote'  => $u,
3420                 'ditemid' => $itemid * 256 + $oldevent->{'anum'},
3421                 'method'  => 'protocol',
3422             );
3423         }
3424
3425         # We must use property 'dupsig_post' in author of entry to be deleted, not in
3426         # remote user or journal owner!
3427         my $item = LJ::get_log2_row($uowner, $itemid);
3428         my $poster = $item ? LJ::want_user($item->{'posterid'}) : '';
3429
3430         LJ::delete_entry($uowner, $itemid, 'quick', $oldevent->{'anum'});
3431
3432         # clear their duplicate protection, so they can later repost
3433         # what they just deleted.  (or something... probably rare.)
3434         $poster->clear_prop('dupsig_post') if $poster && LJ::get_cluster_reader($poster);
3435
3436         my $res = {
3437             'itemid' => $itemid,
3438             'anum' => $oldevent->{'anum'},
3439             xc3 => {
3440                 u => $u
3441             }
3442         };
3443
3444         if ( $itemid == $uowner->get_sticky_entry_id() ) {
3445             $uowner->remove_sticky_entry_id();
3446         }
3447
3448     $dbh->do("UPDATE userusage SET timeupdate=NOW() ".
3449              "WHERE userid=$ownerid");
3450     LJ::MemCache::set([$ownerid, "tu:$ownerid"], pack("N", time()), 30*60);
3451
3452         return $res;
3453     }
3454
3455     # now make sure the new entry text isn't $CannotBeShown
3456     return fail($err, 210)
3457         if $req->{event} eq $CannotBeShown;
3458
3459     if (!LJ::is_enabled("delayed_entries")) {
3460         # don't allow backdated posts in communities
3461         return fail($err,152) if
3462                     ($req->{'props'}->{"opt_backdated"} &&
3463                      $uowner->{'journaltype'} ne "P");
3464     }
3465
3466     # make year/mon/day/hour/min optional in an edit event,
3467     # and just inherit their old values
3468     {
3469         $oldevent->{'eventtime'} =~ /^(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d)/;
3470         $req->{'year'} = $1 unless defined $req->{'year'};
3471         $req->{'mon'} = $2+0 unless defined $req->{'mon'};
3472         $req->{'day'} = $3+0 unless defined $req->{'day'};
3473         $req->{'hour'} = $4+0 unless defined $req->{'hour'};
3474         $req->{'min'} = $5+0 unless defined $req->{'min'};
3475     }
3476
3477     # updating an entry:
3478     return undef
3479         unless common_event_validation($req, $err, $flags);
3480
3481     ### load existing meta-data
3482     my %curprops;
3483     LJ::load_log_props2($dbcm, $ownerid, [ $itemid ], \%curprops);
3484
3485
3486     # create, edit, revoke repost offer
3487     my ($repost_offer, $repost_offer_action);
3488
3489     if (LJ::is_enabled("paid_repost") && $req->{'event'} =~ /\S/) {
3490         my $error;
3491
3492         ($repost_offer, $repost_offer_action) = LJ::Pay::Repost::Offer->from_edit_entry(
3493             \$req->{event},
3494             {
3495                 current     => $curprops{$itemid}->{repost_offer},
3496                 userid      => $posterid,
3497                 journalid   => $ownerid,
3498                 jitemid     => $itemid,
3499                 budget      => $req->{repost_budget},
3500                 limit_sc    => $req->{repost_limit_sc},
3501                 revoke      => !$req->{paid_repost_on},
3502             },
3503             \$error,
3504         );
3505
3506         unless ($flags->{noauth}) {
3507             # cannot create or edit repost offer via api
3508             return fail($err,222) if $repost_offer && $repost_offer_action =~ /create|edit/;
3509
3510             # do not revoke repost offer via api
3511             undef $repost_offer if $repost_offer && $repost_offer_action =~ /revoke/;
3512         }
3513
3514         return fail($err,160,$error) if $error;
3515     }
3516
3517     # make post sticky
3518     if ( $req->{sticky} ) {
3519         if( $uowner->get_sticky_entry_id() != $itemid ) {
3520             $uowner->set_sticky_id($itemid);
3521
3522             my $state_date = POSIX::strftime("%Y-%m-%d", gmtime);
3523             my $postfix = '';
3524             if ($uowner->is_community) {
3525                 $postfix = '_community';
3526             }
3527
3528             my $sticky_entry = "stat:sticky$postfix:$state_date";
3529             LJ::MemCache::incr($sticky_entry, 1) ||
3530                 (LJ::MemCache::add($sticky_entry, 0),  LJ::MemCache::incr($sticky_entry, 1));
3531         }
3532     }
3533     elsif ( $itemid == $uowner->get_sticky_entry_id() ) {
3534         $uowner->remove_sticky_entry_id();
3535     }
3536
3537     ## give features
3538     my $give_features = $req->{'props'}->{'give_features'};
3539     if ($give_features) {
3540         $req->{'props'}->{'give_features'} = ($give_features eq 'enable') ? 1 : 0;
3541     }
3542
3543     my $event = $req->{'event'};
3544     my $owneru = LJ::load_userid($ownerid);
3545     $event = LJ::EmbedModule->transform_rte_post($event);
3546     LJ::EmbedModule->parse_module_embed($owneru, \$event);
3547
3548     my $bytes = length($event) + length($req->{'subject'});
3549
3550     my $eventtime = sprintf("%04d-%02d-%02d %02d:%02d",
3551                             map { $req->{$_} } qw(year mon day hour min));
3552     my $qeventtime = $dbcm->quote($eventtime);
3553
3554     # preserve old security by default, use user supplied if it's understood
3555     my $security = $oldevent->{security};
3556     $security = $req->{security}
3557         if $req->{security} &&
3558            $req->{security} =~ /^(?:public|private|usemask)$/;
3559
3560     $qallowmask = $oldevent->{allowmask} unless defined $req->{'allowmask'};
3561
3562     my $do_tags = $req->{props} && defined $req->{props}->{taglist};
3563     if ($oldevent->{security} ne $security || $qallowmask != $oldevent->{allowmask}) {
3564         # FIXME: this is a hopefully temporary hack which deletes tags from the entry
3565         # when the security has changed.  the real fix is to make update_logtags aware
3566         # of security changes so it can update logkwsum appropriately.
3567
3568         unless ($do_tags) {
3569             # we need to fix security on this entry's tags, but the user didn't give us a tag list
3570             # to work with, so we have to go get the tags on the entry, and construct a tag list,
3571             # in order to pass to update_logtags down at the bottom of this whole update
3572             my $tags = LJ::Tags::get_logtags($uowner, $itemid);
3573             $tags = $tags->{$itemid};
3574             $req->{props}->{taglist} = join(',', sort values %{$tags || {}});
3575             $do_tags = 1; # bleh, force the update later
3576         }
3577
3578         LJ::Tags::delete_logtags($uowner, $itemid);
3579     }
3580
3581     my $qyear = $req->{'year'}+0;
3582     my $qmonth = $req->{'mon'}+0;
3583     my $qday = $req->{'day'}+0;
3584
3585     if ($eventtime ne $oldevent->{'eventtime'} ||
3586         $security ne $oldevent->{'security'} ||
3587         (!$curprops{$itemid}->{opt_backdated} && $req->{props}{opt_backdated}) ||
3588         $qallowmask != $oldevent->{'allowmask'})
3589     {
3590         # are they changing their most recent post?
3591         LJ::load_user_props($u, "newesteventtime");
3592         if ($u->{userid} == $uowner->{userid} &&
3593             $u->{newesteventtime} eq $oldevent->{eventtime}) {
3594                 if (!$curprops{$itemid}->{opt_backdated} && $req->{props}{opt_backdated}) {
3595                     # if they set the backdated flag, then we no longer know
3596                     # the newesteventtime.
3597                     $u->clear_prop('newesteventtime');
3598                 } elsif ($eventtime ne $oldevent->{eventtime}) {
3599                     # otherwise, if they changed time on this event,
3600                     # the newesteventtime is this event's new time.
3601                     $u->set_prop( 'newesteventtime' => $eventtime );
3602                }
3603         }
3604
3605         my $qsecurity = $uowner->quote($security);
3606         my $dberr;
3607         LJ::run_hooks('report_entry_update', $ownerid, $itemid);
3608         $uowner->log2_do(\$dberr, "UPDATE log2 SET eventtime=$qeventtime, revttime=$LJ::EndOfTime-".
3609                          "UNIX_TIMESTAMP($qeventtime), year=$qyear, month=$qmonth, day=$qday, ".
3610                          "security=$qsecurity, allowmask=$qallowmask WHERE journalid=$ownerid ".
3611                          "AND jitemid=$itemid");
3612         return fail($err,501,$dberr) if $dberr;
3613
3614         # update memcached
3615         my $sec = $qallowmask;
3616         $sec = 0 if $security eq 'private';
3617         $sec = 2**31 if $security eq 'public';
3618
3619         my $row = pack("NNNNN", $oldevent->{'posterid'},
3620                        LJ::TimeUtil->mysqldate_to_time($eventtime, 1),
3621                        LJ::TimeUtil->mysqldate_to_time($oldevent->{'logtime'}, 1),
3622                        $sec,
3623                        $itemid*256 + $oldevent->{'anum'});
3624
3625         LJ::MemCache::set([$ownerid, "log2:$ownerid:$itemid"], $row);
3626         LJ::Entry->reset_singletons; ## flush cached LJ::Entry objects
3627     }
3628
3629     if ($security ne $oldevent->{'security'} ||
3630         $qallowmask != $oldevent->{'allowmask'})
3631     {
3632         if ($security eq "public" || $security eq "private") {
3633             $uowner->do("DELETE FROM logsec2 WHERE journalid=$ownerid AND jitemid=$itemid");
3634         }
3635         else {
3636             $uowner->do("REPLACE INTO logsec2 (journalid, jitemid, allowmask) ".
3637                         "VALUES ($ownerid, $itemid, $qallowmask)");
3638         }
3639         return fail($err,501,$dbcm->errstr) if $uowner->err;
3640     }
3641
3642     LJ::MemCache::set([$ownerid,"logtext:$clusterid:$ownerid:$itemid"],
3643                       [ $req->{'subject'}, $event ]);
3644
3645     if (!$flags->{'use_old_content'} && (
3646         $event ne $oldevent->{'event'} ||
3647         $req->{'subject'} ne $oldevent->{'subject'}))
3648     {
3649         LJ::run_hooks('report_entry_text_update', $ownerid, $itemid);
3650         $uowner->do("UPDATE logtext2 SET subject=?, event=? ".
3651                     "WHERE journalid=$ownerid AND jitemid=$itemid", undef,
3652                     $req->{'subject'}, LJ::text_compress($event));
3653         return fail($err,501,$uowner->errstr) if $uowner->err;
3654
3655         # update disk usage
3656         $uowner->dudata_set('L', $itemid, $bytes);
3657     }
3658
3659     # up the revision number
3660     $req->{'props'}->{'revnum'} = ($curprops{$itemid}->{'revnum'} || 0) + 1;
3661     $req->{'props'}->{'revtime'} = time();
3662
3663     my $res = { 'itemid' => $itemid };
3664
3665     # update or create repost offer
3666     if ($repost_offer) {
3667         my ($error, $warning);
3668
3669         if($repost_offer_action eq 'create') {
3670
3671             my $offer_id = LJ::Pay::Repost::Offer->create(\$error, %$repost_offer) or
3672                 fail(\$warning,160,$error);
3673
3674         } elsif($repost_offer_action eq 'edit') {
3675             $repost_offer->edit(\$error,
3676                                 add_budget => $repost_offer->{add_budget},
3677                                 limit_sc   => $repost_offer->{limit_sc},
3678                                 ) or fail(\$warning,160,$error);
3679
3680         } elsif($repost_offer_action eq 'revoke') {
3681
3682             $repost_offer->revoke(\$error) or
3683                 fail(\$warning,161,$error);
3684         }
3685
3686         push @{$res->{warnings} ||= []}, error_message($warning) if $warning;
3687     }
3688
3689
3690     # handle tags if they're defined
3691     if ($do_tags) {
3692         my $tagerr = "";
3693         my $skipped_tags = [];
3694         my $rv = LJ::Tags::update_logtags($uowner, $itemid, {
3695                 set_string => $req->{props}->{taglist},
3696                 remote => $u,
3697                 err_ref => \$tagerr,
3698                 skipped_tags => $skipped_tags, # do all possible and report impossible
3699             });
3700         push @{$res->{warnings} ||= []}, LJ::Lang::ml('/update.bml.tags.skipped', { 'tags' => join(', ', @$skipped_tags),
3701                                                              'limit' => $uowner->get_cap('tags_max') } )
3702             if @$skipped_tags;
3703     }
3704
3705     if (LJ::is_enabled('default_copyright', $u)) {
3706         unless (defined $req->{'props'}->{'copyright'}) { # try 1: previous value
3707             $req->{'props'}->{'copyright'} = $curprops{$itemid}->{'copyright'};
3708         }
3709
3710         unless (defined $req->{'props'}->{'copyright'}) { # try 2: global setting
3711             $req->{'props'}->{'copyright'} = $uowner->prop('default_copyright');
3712         }
3713
3714         unless (defined $req->{'props'}->{'copyright'}) { # try 3: allow
3715             $req->{'props'}->{'copyright'} = 'P';
3716         }
3717     }
3718     else { # disabled feature
3719         delete $req->{'props'}->{'copyright'};
3720     }
3721
3722     my $entry = LJ::Entry->new($ownerid, jitemid => $itemid);
3723
3724     # handle the props
3725     {
3726         my $propset = {};
3727         foreach my $pname (keys %{$req->{'props'}}) {
3728             my $p = LJ::get_prop("log", $pname);
3729             next unless $p;
3730             $propset->{$pname} = $req->{'props'}->{$pname};
3731         }
3732         $entry->set_prop_multi($propset);
3733
3734         if ($req->{'props'}->{'copyright'} ne $curprops{$itemid}->{'copyright'}) {
3735             LJ::Entry->new($ownerid, jitemid => $itemid)->put_logprop_in_history('copyright', $curprops{$itemid}->{'copyright'},
3736                                                                                   $req->{'props'}->{'copyright'});
3737         }
3738     }
3739
3740     # compatible with depricated 'opt_backdated'
3741     if ($req->{'props'}->{'opt_backdated'} eq "1" &&
3742         $oldevent->{'rlogtime'} != $LJ::EndOfTime) {
3743         my $dberr;
3744         LJ::run_hooks('report_entry_update', $ownerid, $itemid);
3745         $uowner->log2_do(undef, "UPDATE log2 SET rlogtime=$LJ::EndOfTime WHERE ".
3746                          "journalid=$ownerid AND jitemid=$itemid");
3747         return fail($err,501,$dberr) if $dberr;
3748     }
3749
3750     if ($req->{'props'}->{'opt_backdated'} eq "0" &&
3751         $oldevent->{'rlogtime'} == $LJ::EndOfTime) {
3752         my $dberr;
3753         LJ::run_hooks('report_entry_update', $ownerid, $itemid);
3754         $uowner->log2_do(\$dberr, "UPDATE log2 SET rlogtime=$LJ::EndOfTime-UNIX_TIMESTAMP(logtime) ".
3755                          "WHERE journalid=$ownerid AND jitemid=$itemid");
3756         return fail($err,501,$dberr) if $dberr;
3757     }
3758     return fail($err,501,$dbcm->errstr) if $dbcm->err;
3759
3760     if (defined $oldevent->{'anum'}) {
3761         $res->{'anum'} = $oldevent->{'anum'};
3762         $res->{'url'} = LJ::item_link($uowner, $itemid, $oldevent->{'anum'});
3763         $res->{'ditemid'} = $itemid * 256 + $oldevent->{'anum'};
3764     }
3765
3766     $dbh->do("UPDATE userusage SET timeupdate=NOW() ".
3767              "WHERE userid=$ownerid");
3768     LJ::MemCache::set([$ownerid, "tu:$ownerid"], pack("N", time()), 30*60);
3769
3770     LJ::EventLogRecord::EditEntry->new($entry)->fire;
3771     my @jobs; # jobs to insert into TheSchwartz
3772     LJ::run_hooks("editpost", $entry, \@jobs);
3773
3774     # PubSubHubbub Support
3775     LJ::Feed::generate_hubbub_jobs($uowner, \@jobs) unless $uowner->is_syndicated;
3776
3777     my $sclient = LJ::theschwartz();
3778     if ($sclient && @jobs) {
3779         my @handles = $sclient->insert_jobs(@jobs);
3780         # TODO: error on failure?  depends on the job I suppose?  property of the job?
3781     }
3782
3783     $res->{xc3} = {
3784         u => $u,
3785         post => {
3786             url         => $res->{url},
3787             coords      => $req->{props}->{current_coords},
3788             has_images  => ($req->{event} =~ /pics\.livejournal\.com/ ? 1 : 0),
3789             from_mobile => ($req->{event} =~ /m\.livejournal\.com/ ? 1 : 0)
3790         }
3791     };
3792
3793     return $res;
3794 }
3795
3796 sub getevents {
3797     my ($req, $err, $flags) = @_;
3798
3799     $flags->{allow_anonymous} = 1;
3800     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getevents');
3801
3802     $flags->{'ignorecanuse'} = 1; # later we will check security levels, so allow some access to communities
3803     return undef unless check_altusage($req, $err, $flags);
3804
3805     my $u = $flags->{'u'};
3806     my $uowner = $flags->{'u_owner'} || $u;
3807
3808     ### shared-journal support
3809     my $posterid = ($u ? $u->{'userid'} : 0);
3810     my $ownerid = $flags->{'ownerid'};
3811
3812     if( $req->{journalid} ){
3813         $ownerid = $req->{journalid};
3814         $uowner = LJ::load_userid( $req->{journalid} );
3815     }
3816
3817     my $sticky_id = $uowner->prop("sticky_entry_id") || undef;
3818     my $dbr = LJ::get_db_reader();
3819     my $sth;
3820
3821     my $dbcr =  LJ::get_cluster_reader($uowner);
3822     return fail($err, 502) unless $dbcr && $dbr;
3823
3824     # can't pull events from deleted/suspended journal
3825     return fail($err, 307) unless $uowner->{'statusvis'} eq "V" || $uowner->is_readonly;
3826
3827     my $reject_code = $LJ::DISABLE_PROTOCOL{getevents};
3828
3829     if (ref $reject_code eq "CODE") {
3830         my $errmsg = $reject_code->($req, $flags, eval { LJ::request->request });
3831
3832         return fail($err, "311", $errmsg) if $errmsg;
3833     }
3834
3835     my $secmask = 0;
3836
3837     if ($u && ($u->{'journaltype'} eq "P" || $u->{'journaltype'} eq "I") && $posterid != $ownerid) {
3838         $secmask = LJ::get_groupmask($ownerid, $posterid);
3839     }
3840
3841     # decide what level of security the remote user can see
3842     # 'getevents' used in small count of places and we will not pass 'viewall' through their call chain
3843     my $secwhere = "";
3844
3845     if ($posterid == $ownerid) {
3846         # no extra where restrictions... user can see all their own stuff
3847     }
3848     elsif ($secmask) {
3849         # can see public or things with them in the mask
3850         # and own posts in non-sensitive communities
3851         if ($LJ::JOURNALS_WITH_PROTECTED_CONTENT{ $uowner->{user} }) {
3852             $secwhere = "AND (security='public' OR (security='usemask' AND allowmask & $secmask != 0))";
3853         }
3854         else {
3855             $secwhere = "AND (security='public' OR (security='usemask' AND allowmask & $secmask != 0) OR posterid=$posterid)";
3856         }
3857     }
3858     else {
3859         # not a friend?  only see public.
3860         # and own posts in non-sensitive communities
3861         if ($LJ::JOURNALS_WITH_PROTECTED_CONTENT{ $uowner->{user} } || !$posterid) {
3862             $secwhere = "AND (security='public')";
3863         }
3864         else{
3865             $secwhere = "AND (security='public' OR posterid=$posterid)";
3866         }
3867     }
3868
3869     # if this is on, we sort things different (logtime vs. posttime)
3870     # to avoid timezone issues
3871     my $is_community = ($uowner->{'journaltype'} eq "C" ||
3872                         $uowner->{'journaltype'} eq "S");
3873
3874     # in some cases we'll use the master, to ensure there's no
3875     # replication delay.  useful cases: getting one item, use master
3876     # since user might have just made a typo and realizes it as they
3877     # post, or wants to append something they forgot, etc, etc.  in
3878     # other cases, slave is pretty sure to have it.
3879     my $use_master = 0;
3880
3881     # just synonym
3882     if ($req->{'itemshow'}){
3883         $req->{'selecttype'} = 'lastn' unless $req->{'selecttype'};
3884         $req->{'howmany'} = $req->{'itemshow'};
3885     }
3886
3887     my $skip = $req->{'skip'} + 0;
3888
3889     $skip = 500 if $skip > 500;
3890
3891     my $sort_order = $req->{'sort_order'};
3892     $sort_order = ($sort_order && $sort_order =~ /asc|desc|default/ ? $sort_order : 'default');
3893
3894     if ( $req->{ver} > 3 && LJ::is_enabled("delayed_entries") ) {
3895         my $res = {};
3896
3897         if ( $req->{delayed} ) {
3898             return fail( $err, 220 ) if $req->{view} && $req->{view} ne 'stored';
3899
3900             if ( $req->{selecttype} eq 'lastn' ) {
3901                 my $uid     = $u->userid;
3902                 my $howmany = $req->{'howmany'} || 20;
3903                 if ($howmany > 50) { $howmany = 50; }
3904
3905                 my $ids = LJ::DelayedEntry->get_entries_by_journal(
3906                                             $uowner,
3907                                             { 'skip'    => $req->{skip} || 0,
3908                                               'show'    => $howmany,
3909                                               'userid'  => $uid, });
3910
3911                 for my $did ( @$ids ) {
3912                     my $entry = LJ::DelayedEntry->get_entry_by_id(
3913                         $uowner,
3914                         $did,
3915                         { 'userid' => $uid, },
3916                     );
3917
3918                     if (!$entry) {
3919                         next;
3920                     }
3921
3922                     my $re = {};
3923
3924                     $re->{$_} = $entry->$_ for qw(delayedid subject event logtime);
3925                     my $props = $entry->props;
3926                     foreach my $key (keys %$props) {
3927                         if (!$props->{$key}) {
3928                             delete $props->{$key};
3929                         }
3930                     }
3931
3932                     $re->{props}           = $props;
3933                     $re->{eventtime}       = $entry->posttime;
3934                     $re->{event_timestamp} = $entry->system_posttime;
3935                     $re->{url}             = $entry->url;
3936                     $re->{security}        = $entry->security;
3937                     $re->{allowmask}       = $entry->allowmask;
3938                     $re->{posterid}        = $entry->poster->userid;
3939                     $re->{poster}          = $entry->poster->username;
3940
3941                     push @{$res->{events}}, $re;
3942                 }
3943             }
3944             elsif ( $req->{selecttype} eq 'one' ) {
3945                 return fail( $err, 218) unless $req->{delayedid};
3946                 my $uid = $u->userid;
3947
3948                 my $entry = LJ::DelayedEntry->get_entry_by_id(
3949                     $uowner,
3950                     $req->{delayedid},
3951                     { 'userid' => $uid, },
3952                 );
3953
3954                 my $re = {};
3955
3956                 if (!$entry)  {
3957                     next;
3958                 }
3959
3960                 $re->{$_} = $entry->$_ for qw(delayedid subject event logtime);
3961                 my $props = $entry->props;
3962                 foreach my $key (keys %$props) {
3963                     if (!$props->{$key}) {
3964                         delete $props->{$key};
3965                     }
3966                 }
3967
3968                 $re->{props}           = $props;
3969                 $re->{eventtime}       = $entry->posttime;
3970                 $re->{event_timestamp} = $entry->system_posttime;
3971                 $re->{url}             = $entry->url;
3972                 $re->{security}        = $entry->security;
3973                 $re->{allowmask}       = $entry->allowmask;
3974                 $re->{posterid}        = $entry->poster->userid;
3975                 $re->{poster}          = $entry->poster->username;
3976
3977                 push @{$res->{events}}, $re;
3978             } elsif ( $req->{selecttype} eq 'multiple' ) {
3979                 return fail( $err, 218) unless $req->{delayedids};
3980                 my $uid = $u->userid;
3981
3982
3983                 for my $did ( @{$req->{delayedids} }) {
3984                     my $entry = LJ::DelayedEntry->get_entry_by_id(
3985                         $uowner,
3986                         $did,
3987                         { 'userid' => $uid, },
3988                     );
3989
3990                     if (!$entry)  {
3991                         next;
3992                     }
3993
3994                     my $re = {};
3995
3996                     $re->{$_} = $entry->$_ for qw(delayedid subject event logtime);
3997                     my $props = $entry->props;
3998                     foreach my $key (keys %$props) {
3999                         if (!$props->{$key}) {
4000                             delete $props->{$key};
4001                         }
4002                     }
4003
4004                     $re->{props}           = $props;
4005                     $re->{eventtime}       = $entry->posttime;
4006                     $re->{event_timestamp} = $entry->system_posttime;
4007                     $re->{url}             = $entry->url;
4008                     $re->{security}        = $entry->security;
4009                     $re->{allowmask}       = $entry->allowmask;
4010                     $re->{posterid}        = $entry->poster->userid;
4011                     $re->{poster}          = $entry->poster->username;
4012                     push @{$res->{events}}, $re;
4013                 }
4014              }
4015             else {
4016                 return fail( $err, 218 );
4017             }
4018
4019             return $res;
4020         }
4021     }
4022
4023     # build the query to get log rows.  each selecttype branch is
4024     # responsible for either populating the following 3 variables
4025     # OR just populating $sql
4026     my ($orderby, $where, $limit, $offset);
4027     my $sql;
4028
4029     if ($req->{'selecttype'} eq "day") {
4030         return fail($err,203)
4031             unless ($req->{'year'} =~ /^\d\d\d\d$/ &&
4032                     $req->{'month'} =~ /^\d\d?$/ &&
4033                     $req->{'day'} =~ /^\d\d?$/ &&
4034                     $req->{'month'} >= 1 && $req->{'month'} <= 12 &&
4035                     $req->{'day'} >= 1 && $req->{'day'} <= 31);
4036
4037         my $qyear = $dbr->quote($req->{'year'});
4038         my $qmonth = $dbr->quote($req->{'month'});
4039         my $qday = $dbr->quote($req->{'day'});
4040         $where = "AND year=$qyear AND month=$qmonth AND day=$qday";
4041         $limit = "LIMIT 200";  # FIXME: unhardcode this constant (also in ljviews.pl)
4042
4043         # see note above about why the sort order is different
4044         $orderby = $is_community ? "ORDER BY logtime" : "ORDER BY eventtime";
4045     }
4046     elsif ($req->{'selecttype'} eq "lastn") {
4047         my $howmany = $req->{'howmany'} || 20;
4048
4049         if ($howmany > 50) { $howmany = 50; }
4050
4051         $howmany = $howmany + 0;
4052         $limit = "LIMIT $howmany";
4053
4054         $offset = "OFFSET $skip";
4055
4056         # okay, follow me here... see how we add the revttime predicate
4057         # even if no beforedate key is present?  you're probably saying,
4058         # that's retarded -- you're saying: "revttime > 0", that's like
4059         # saying, "if entry occurred at all."  yes yes, but that hints
4060         # mysql's braindead optimizer to use the right index.
4061         my $rtime_after = 0;
4062         my $rtime_what = $is_community ? "rlogtime" : "revttime";
4063
4064         if ($req->{'beforedate'}) {
4065             return fail($err,203,'xmlrpc.des.bad_value',{'param'=>'beforedate'})
4066                 unless ($req->{'beforedate'} =~
4067                         /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d$/);
4068             my $qd = $dbr->quote($req->{'beforedate'});
4069             $rtime_after = "$LJ::EndOfTime-UNIX_TIMESTAMP($qd)";
4070         }
4071
4072         $where .= "AND $rtime_what > $rtime_after ";
4073         $orderby = "ORDER BY $rtime_what";
4074         unless ($sort_order eq 'default') {
4075             $orderby .= ' '.uc($sort_order);
4076         }
4077
4078         unless ($skip) {
4079             $where .= "OR ( journalid=$ownerid $secwhere $where AND jitemid=$sticky_id)" if defined $sticky_id;
4080         }
4081     }
4082     elsif ($req->{'selecttype'} eq "one" && ($req->{'itemid'} eq "-1" || $req->{'ditemid'} eq "-1")) {
4083         $use_master = 1;  # see note above.
4084         $limit = "LIMIT 1";
4085         $orderby = "ORDER BY rlogtime";
4086     }
4087     elsif ($req->{'selecttype'} eq "one") {
4088         $req->{'itemid'} = int(($req->{'ditemid'} + 0) / 256)  unless($req->{'itemid'});
4089         my $id = $req->{'itemid'} + 0;
4090         $where = "AND jitemid=$id";
4091     }
4092     elsif ($req->{'selecttype'} eq "syncitems") {
4093         return fail($err, 506) if $LJ::DISABLED{'syncitems'};
4094
4095         my $date = $req->{'lastsync'} || "0000-00-00 00:00:00";
4096         return fail($err, 203, 'xmlrpc.des.bad_value',{'param'=>'syncitems'})
4097             unless ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
4098
4099         return fail($err, 301, 'xmlrpc.des.syncitems_unavailable') unless($uowner || $u);
4100
4101         my $now = time();
4102
4103         # broken client loop prevention
4104         # TODO: Just add rate limits here instead of that old stuff
4105         my $u_req = ($u ? $u : $uowner);
4106         if ($req->{'lastsync'}) {
4107             my $pname = "rl_syncitems_getevents_loop";
4108             LJ::load_user_props($u_req, $pname);
4109
4110             # format is:  time/date/time/date/time/date/... so split
4111             # it into a hash, then delete pairs that are older than an hour
4112             my %reqs = split(m!/!, $u_req->{$pname});
4113
4114             foreach (grep { $_ < $now - 60*60 } keys %reqs) { delete $reqs{$_}; }
4115             my $count = grep { $_ eq $date } values %reqs;
4116             $reqs{$now} = $date;
4117
4118             if ($count >= 2) {
4119                 # 2 prior, plus this one = 3 repeated requests for same synctime.
4120                 # their client is busted.  (doesn't understand syncitems semantics)
4121                 return fail($err,406);
4122             }
4123
4124             $u_req->set_prop( $pname => join( '/', map { $_ => $reqs{$_} }
4125                                                sort { $b <=> $a }
4126                                                keys %reqs ) );
4127         }
4128
4129         my %item;
4130         $sth = $dbcr->prepare("SELECT jitemid, logtime FROM log2 WHERE ".
4131                               "journalid=? and logtime > ? $secwhere");
4132         $sth->execute($ownerid, $date);
4133
4134         while (my ($id, $dt) = $sth->fetchrow_array) {
4135             $item{$id} = $dt;
4136         }
4137
4138         my $p_revtime = LJ::get_prop("log", "revtime");
4139         $sth = $dbcr->prepare("SELECT jitemid, FROM_UNIXTIME(value) ".
4140                               "FROM logprop2 WHERE journalid=? ".
4141                               "AND propid=$p_revtime->{'id'} ".
4142                               "AND value+0 > UNIX_TIMESTAMP(?)");
4143         $sth->execute($ownerid, $date);
4144
4145         while (my ($id, $dt) = $sth->fetchrow_array) {
4146             $item{$id} = $dt;
4147         }
4148
4149         my $limit = 100;
4150         my @ids = sort { $item{$a} cmp $item{$b} } keys %item;
4151
4152         if (@ids > $limit) { @ids = @ids[0..$limit-1]; }
4153
4154         my $in = join(',', @ids) || "0";
4155         $where = "AND jitemid IN ($in)";
4156     }
4157     elsif ($req->{'selecttype'} eq "multiple") {
4158         my @ids;
4159         if($req->{'itemids'}) {
4160             foreach my $num (split(/\s*,\s*/, $req->{'itemids'})) {
4161                 return fail($err, 203, 'xmlrpc.des.non_arifmetic', {'param'=>'itemid', 'value'=>$num}) unless $num =~ /^\d+$/;
4162                 push @ids, $num;
4163             }
4164         } elsif ($req->{'ditemids'}) {
4165             foreach my $num (split(/\s*,\s*/, $req->{'ditemids'})) {
4166                 return fail($err, 203, 'xmlrpc.des.non_arifmetic', {'param'=>'itemid', 'value'=>$num}) unless $num =~ /^\d+$/;
4167                 push @ids, int(($num+0)/256);
4168             }
4169         }
4170         my $limit = 100;
4171         return fail($err, 209, 'xmlrpc.des.entries_limit', {'limit'=>$limit}) if @ids > $limit;
4172
4173         my $in = join(',', @ids);
4174         $where = "AND jitemid IN ($in)";
4175     }
4176     elsif ($req->{'selecttype'} eq 'before') {
4177         my $before     = $req->{'before'};
4178         my $itemshow   = $req->{'howmany'};
4179         my $itemselect = $itemshow + $skip;
4180
4181         my %item;
4182         $sth = $dbcr->prepare("SELECT jitemid, logtime FROM log2 WHERE ".
4183                               "journalid=? AND logtime < ? $secwhere LIMIT $itemselect");
4184         $sth->execute($ownerid, $before);
4185
4186         while (my ($id, $dt) = $sth->fetchrow_array) {
4187             $item{$id} = $dt;
4188         }
4189
4190         my $p_revtime = LJ::get_prop("log", "revtime");
4191
4192         $sth = $dbcr->prepare("SELECT jitemid, FROM_UNIXTIME(value) ".
4193                               "FROM logprop2 WHERE journalid=? ".
4194                               "AND propid=$p_revtime->{'id'} ".
4195                               "AND value+0 < ? LIMIT $itemselect");
4196         $sth->execute($ownerid, $before);
4197
4198         while (my ($id, $dt) = $sth->fetchrow_array) {
4199             $item{$id} = $dt;
4200         }
4201
4202         my @ids = sort { $item{$a} cmp $item{$b} } keys %item;
4203
4204         $orderby = "ORDER BY jitemid";
4205         unless ($sort_order eq 'default') {
4206             $orderby .= ' '.uc($sort_order);
4207         }
4208
4209         if (@ids > $skip) {
4210             @ids = @ids[$skip..(@ids-1)];
4211             @ids = @ids[0..$itemshow-1] if @ids > $itemshow;
4212         }
4213         else {
4214             @ids = ();
4215         }
4216
4217         my $in = join(',', @ids) || "0";
4218         $where = "AND jitemid IN ($in)";
4219     }
4220     elsif ($req->{'selecttype'} eq 'tag') {
4221
4222         my $empty_res = {
4223             skip => $skip,
4224             xc3  => { u => $u },
4225             events => [],
4226         };
4227
4228         my $howmany = $req->{'howmany'} || 20;
4229         if ($howmany > 50) { $howmany = 50; }
4230         $howmany = $howmany + 0;
4231
4232         $limit = "LIMIT $howmany";
4233         $offset = "OFFSET $skip";
4234
4235         my $rtime_what = $is_community ? "rlogtime" : "revttime";
4236         $orderby = "ORDER BY $rtime_what";
4237
4238         unless ($sort_order eq 'default') {
4239             $orderby .= ' '.uc($sort_order);
4240         }
4241
4242         my $jitemids;
4243
4244         my ($tagids, $tagnames, $tags, $known_tags) = ([], [], {}, {});
4245
4246         return fail($err,225)
4247             unless LJ::Tags::is_valid_tagstring($req->{'tags'}, $tagnames, { omit_underscore_check => 1 });
4248
4249         $tags = LJ::Tags::get_usertags($uowner, { remote => $u });
4250
4251         return $empty_res unless $tags && %$tags;
4252
4253         while ( my ($tid, $tag) = each %$tags ) {
4254             $known_tags->{LJ::Text->normalize_tag_name($tag->{name})} = $tid;
4255         }
4256
4257         my $tagmode = lc $req->{'tagmode'};
4258
4259         $tagids = [ map {
4260             my $tid = $known_tags->{LJ::Text->normalize_tag_name($_)};
4261             $tid ?
4262                 $tid :
4263                 ( $tagmode eq 'and' ? return $empty_res : () );
4264         } @$tagnames ];
4265
4266         return $empty_res unless $tagids && @$tagids;
4267
4268         if ($tagmode eq 'and') {
4269
4270             my $limit = $LJ::TAG_INTERSECTION;
4271             $#{$tagids} = $limit - 1 if @{$tagids} > $limit;
4272             my $in = join(',', map { $_+0 } @{$tagids});
4273             my $sth = $dbcr->prepare("SELECT jitemid, kwid FROM logtagsrecent WHERE journalid = ? AND kwid IN ($in)");
4274             $sth->execute($ownerid);
4275
4276             my %mix;
4277             while (my $row = $sth->fetchrow_arrayref) {
4278                 my ($jitemid, $kwid) = @$row;
4279                 $mix{$jitemid}++;
4280             }
4281
4282             my $need = @{$tagids};
4283             foreach my $jitemid (keys %mix) {
4284                 delete $mix{$jitemid} if $mix{$jitemid} < $need;
4285             }
4286
4287             $jitemids = [keys %mix];
4288         } else { # mode: 'or'
4289             # select jitemids uniquely
4290             my $in = join(',', map { $_+0 } @{$tagids});
4291             $jitemids = $dbcr->selectcol_arrayref(qq{
4292                 SELECT DISTINCT jitemid FROM logtagsrecent WHERE journalid = ? AND kwid IN ($in)
4293                 }, undef, $ownerid);
4294         }
4295
4296         return $empty_res unless @$jitemids;
4297
4298         $where = " AND jitemid IN (" .
4299             join(',', map { $_ + 0 } @$jitemids) .
4300             ")";
4301     }
4302     else {
4303         return fail($err,200,'xmlrpc.des.bad_value',{'param'=>'selecttype'});
4304     }
4305
4306     if (my $posterid = int($req->{'posterid'})) {
4307         $where .= " AND posterid=$posterid";
4308     }
4309
4310     # common SQL template:
4311     unless ($sql) {
4312         $sql = "SELECT jitemid, eventtime, security, allowmask, anum, posterid, replycount, UNIX_TIMESTAMP(eventtime), logtime ".
4313             "FROM log2 WHERE journalid=$ownerid $secwhere $where $orderby $limit $offset";
4314     }
4315
4316     # whatever selecttype might have wanted us to use the master db.
4317     $dbcr = LJ::get_cluster_def_reader($uowner) if $use_master;
4318
4319     return fail($err, 502) unless $dbcr;
4320
4321     ## load the log rows
4322     ($sth = $dbcr->prepare($sql))->execute;
4323     return fail($err, 501, $dbcr->errstr) if $dbcr->err;
4324
4325     my $count = 0;
4326     my @itemids = ();
4327
4328     my $res = {
4329         skip => $skip,
4330         xc3  => {
4331             u => $u
4332         }
4333     };
4334
4335     my $events = $res->{'events'} = [];
4336     my %evt_from_itemid;
4337
4338     while (my ($itemid, $eventtime, $sec, $mask, $anum, $jposterid, $replycount, $event_timestamp, $logtime) = $sth->fetchrow_array) {
4339         $count++;
4340
4341         #
4342         # construct LJ::Entry object from row
4343         #
4344         my $evt = {};
4345         my $entry = LJ::Entry->new_from_row(
4346                 'journalid' => $ownerid,
4347                 'jitemid'   => $itemid,
4348                 'allowmask' => $mask,
4349                 'posterid'  => $jposterid,
4350                 'eventtime' => $eventtime,
4351                 'security'  => $sec,
4352                 'anum'      => $anum,
4353             );
4354
4355         #
4356         # final_ownerid, final_anum and $final_itemid could be different
4357         # from ownerid if entry is a repost
4358         #
4359         my $final_ownerid = $ownerid;
4360         my $final_itemid  = $itemid;
4361         my $final_anum    = $anum;
4362
4363         #
4364         # repost_text and repost_subject are using for repost only
4365         #
4366         my $repost_text;
4367         my $repost_subject;
4368
4369         #
4370         # prepare list of variables to substiture values
4371         #
4372         my $repost_entry;
4373         my $content =  { 'original_post_obj' => \$entry,
4374                          'repost_obj'        => \$repost_entry,
4375                          'journalid'         => \$final_ownerid,
4376                          'itemid'            => \$final_itemid,
4377                          'allowmask'         => \$mask,
4378                          'posterid'          => \$jposterid,
4379                          'eventtime'         => \$eventtime,
4380                          'security'          => \$sec,
4381                          'anum'              => \$final_anum,
4382                          'event'             => \$repost_text,
4383                          'subject'           => \$repost_subject,
4384                          'reply_count'       => \$replycount, };
4385
4386         #
4387         # use repost signnture before event text
4388         #
4389         my $repost_props = { use_repost_signature => 0 };
4390
4391         if (LJ::Entry::Repost->substitute_content( $entry, $content, $repost_props )) {
4392              $evt->{'repost_text'}    = $repost_text;
4393              $evt->{'repost_subject'} = $repost_subject;
4394              $evt->{'repost_ownerid'} = $final_ownerid;
4395              $evt->{'repost_itemid'}  = $final_itemid;
4396              $evt->{'repost_anum'}    = $final_anum;
4397              $evt->{'repost_ditemid'} = $final_itemid * 256 + $final_anum;
4398              $evt->{'repost_props'}  = $entry->props;
4399              $evt->{'original_entry_url'} = $entry->url,
4400              $evt->{'repostername'} = $repost_entry->poster->username;
4401              $evt->{'postername'} = $entry->poster->username;
4402              $evt->{'journalname'} = $entry->journal->username;
4403              my $userpic = $entry->userpic;
4404              $evt->{'poster_userpic_url'} = $userpic && $userpic->url;
4405         }
4406
4407         # now my own post, so need to check for suspended prop
4408         if ($jposterid != $posterid) {
4409             next if($entry->is_suspended_for($u));
4410         }
4411
4412         $evt->{'itemid'} = $itemid;
4413         push @itemids, $itemid;
4414
4415         $evt_from_itemid{$itemid} = $evt;
4416
4417         $evt->{"eventtime"}       = $eventtime;
4418         $evt->{"event_timestamp"} = $event_timestamp;
4419         $evt->{"logtime"}         = $logtime;
4420
4421
4422         if ($sec ne "public") {
4423             $evt->{'security'}  = $sec;
4424             $evt->{'allowmask'} = $mask if $sec eq "usemask";
4425         }
4426
4427         $evt->{'anum'} = $anum;
4428         $evt->{'ditemid'} = $itemid * 256 + $anum;
4429
4430         if ($jposterid != $final_ownerid) {
4431             my $uposter = LJ::load_userid($jposterid);
4432             $evt->{'poster'} = $uposter->username;
4433
4434             if ($uposter->identity) {
4435                 my $i = $uposter->identity;
4436                 $evt->{'identity_type'}    = $i->pretty_type;
4437                 $evt->{'identity_value'}   = $i->value;
4438                 $evt->{'identity_url'}     = $i->url($uposter);
4439                 $evt->{'identity_display'} = $uposter->display_name;
4440             }
4441         }
4442
4443         #
4444         # There is using final_ variabled to get correct link
4445         #
4446         $evt->{'url'}         = LJ::item_link(LJ::load_userid($final_ownerid),
4447                                               $final_itemid,
4448                                               $final_anum);
4449
4450         $evt->{'reply_count'} = $replycount;
4451
4452         $evt->{'can_comment'} = $u ? $entry->remote_can_comment($u) : $entry->everyone_can_comment;
4453
4454         if ( $itemid == $sticky_id && $req->{'selecttype'} eq "lastn") {
4455             unshift @$events, $evt,
4456         }
4457         else {
4458             push @$events, $evt;
4459         }
4460     }
4461
4462     # load properties. Even if the caller doesn't want them, we need
4463     # them in Unicode installations to recognize older 8bit non-UF-8
4464     # entries.
4465     unless ($req->{'noprops'} && !$LJ::UNICODE) {
4466         ### do the properties now
4467         $count = 0;
4468         my %props = ();
4469         LJ::load_log_props2($dbcr, $ownerid, \@itemids, \%props);
4470
4471         # load the tags for these entries, unless told not to
4472         unless ($req->{notags}) {
4473             # construct %idsbycluster for the multi call to get these tags
4474             my $tags = LJ::Tags::get_logtags($uowner, \@itemids);
4475
4476             # add to props
4477             foreach my $itemid (@itemids) {
4478                 next unless $tags->{$itemid};
4479                 $props{$itemid}->{taglist} = join(', ', values %{$tags->{$itemid}});
4480             }
4481         }
4482
4483         foreach my $itemid (keys %props) {
4484             # 'replycount' is a pseudo-prop, don't send it.
4485             # FIXME: this goes away after we restructure APIs and
4486             # replycounts cease being transferred in props
4487             delete $props{$itemid}->{'replycount'};
4488
4489             unless ($flags->{noauth}) {
4490                 delete $props{$itemid}->{repost_offer};
4491             }
4492
4493             my $evt = $evt_from_itemid{$itemid};
4494             $evt->{'props'} = {};
4495
4496             foreach my $name (keys %{$props{$itemid}}) {
4497
4498                 my $value = $props{$itemid}->{$name};
4499                 $value =~ s/\n/ /g;
4500
4501                 # normalize props
4502                 unless ($flags->{'noauth'}) {
4503                     my $prop  = LJ::get_prop("log", $name);
4504                     my $ptype = $prop->{'datatype'};
4505
4506                     if ($ptype eq "bool" && $value !~ /^[01]$/) {
4507                         $value = $value ? 1 : 0;
4508                     }
4509                     if ($ptype eq "num" && $value =~ /[^\d]/) {
4510                         $value = int $value;
4511                     }
4512                 }
4513
4514                 $evt->{'props'}->{$name} = $value;
4515             }
4516
4517             if ( $itemid == $sticky_id ) {
4518                 $evt->{'props'}->{'sticky'} = 1;
4519             }
4520         }
4521     }
4522
4523     ## load the text
4524     my $text = LJ::cond_no_cache($use_master, sub {
4525         return LJ::get_logtext2($uowner, @itemids);
4526     });
4527
4528     foreach my $i (@itemids) {
4529         my $t = $text->{$i};
4530         my $evt = $evt_from_itemid{$i};
4531
4532         my $real_uowner = $uowner;
4533
4534         if ($evt->{'repost_text'}) {
4535             $t->[0] = delete $evt->{'repost_subject'};
4536             $t->[1] = delete $evt->{'repost_text'};
4537
4538             $evt->{'props'}    = delete $evt->{'repost_props'}
4539                 unless $req->{'noprops'};
4540
4541             delete $evt->{'props'}{'repost_offer'} if $evt->{'props'};
4542
4543             $evt->{'itemid'}   = delete $evt->{'repost_itemid'};
4544             $evt->{'anum'}     = delete $evt->{'repost_anum'};
4545             $evt->{'ownerid'}  = delete $evt->{'repost_ownerid'};
4546             $evt->{'repost'}   = 1;
4547
4548             $real_uowner = LJ::want_user($evt->{'ownerid'});
4549         }
4550
4551
4552         # if they want subjects to be events, replace event
4553         # with subject when requested.
4554         if ($req->{'prefersubject'} && length($t->[0])) {
4555             $t->[1] = $t->[0];  # event = subject
4556             $t->[0] = undef;    # subject = undef
4557         }
4558
4559         # now that we have the subject, the event and the props,
4560         # auto-translate them to UTF-8 if they're not in UTF-8.
4561         if ($LJ::UNICODE && $req->{'ver'} >= 1 &&
4562                 $evt->{'props'}->{'unknown8bit'}) {
4563             my $error = 0;
4564             $t->[0] = LJ::text_convert($t->[0], $real_uowner, \$error);
4565             $t->[1] = LJ::text_convert($t->[1], $real_uowner, \$error);
4566
4567             foreach (keys %{$evt->{'props'}}) {
4568                 $evt->{'props'}->{$_} = LJ::text_convert($evt->{'props'}->{$_}, $real_uowner, \$error);
4569             }
4570
4571             return fail($err, 208, 'xmlrpc.des.cannnot_display_post',{'siteroot'=>$LJ::SITEROOT})
4572                 if $error;
4573         }
4574
4575         if ($LJ::UNICODE && $req->{'ver'} < 1 && !$evt->{'props'}->{'unknown8bit'}) {
4576             unless ( LJ::is_ascii($t->[0]) &&
4577                      LJ::is_ascii($t->[1]) &&
4578                      LJ::is_ascii(join(' ', values %{$evt->{'props'}}) )) {
4579                 # we want to fail the client that wants to get this entry
4580                 # but we make an exception for selecttype=day, in order to allow at least
4581                 # viewing the daily summary
4582
4583                 if ($req->{'selecttype'} eq 'day') {
4584                     $t->[0] = $t->[1] = $CannotBeShown;
4585                 }
4586                 else {
4587                     return fail($err, 207, 'xmlrpc.des.not_unicode_client', {'siteroot'=>$LJ::SITEROOT});
4588                 }
4589             }
4590         }
4591
4592         if ($t->[0]) {
4593             $t->[0] =~ s/[\r\n]/ /g;
4594             $evt->{'subject'} = $t->[0];
4595         }
4596
4597         $t->[1] = LJ::trim_widgets(
4598             'length'     => $req->{trim_widgets},
4599             'img_length' => $req->{widgets_img_length},
4600             'text'       => $t->[1],
4601             'read_more'  => '<a href="' . $evt->{url} . '"> ...</a>',
4602         ) if $req->{trim_widgets};
4603
4604         LJ::EmbedModule->expand_entry($real_uowner, \$t->[1], get_video_id => 1) if($req->{get_video_ids});
4605         LJ::Poll->expand_entry(\$t->[1], getpolls => 1, viewer => $u) if $req->{get_polls};
4606
4607         if ($req->{view}) {
4608             LJ::EmbedModule->expand_entry($real_uowner, \$t->[1], edit => 1) if $req->{view} eq 'stored';
4609         }
4610         elsif ($req->{parseljtags}) {
4611             $t->[1] = LJ::convert_lj_tags_to_links(
4612                 event => $t->[1],
4613                 embed_url => $evt->{url});
4614         }
4615
4616
4617         # truncate
4618         if ($req->{'truncate'} >= 4) {
4619             my $original = $t->[1];
4620
4621             if ($req->{'ver'} > 1) {
4622                 $t->[1] = LJ::text_trim($t->[1], $req->{'truncate'} - 3, 0);
4623             }
4624             else {
4625                 $t->[1] = LJ::text_trim($t->[1], 0, $req->{'truncate'} - 3);
4626             }
4627
4628             # only append the elipsis if the text was actually truncated
4629             $t->[1] .= "..." if $t->[1] ne $original;
4630         }
4631
4632         # line endings
4633         $t->[1] =~ s/\r//g;
4634
4635         if ($req->{'asxml'}) {
4636             my $tidy = LJ::Tidy->new();
4637             $evt->{'subject'} = $tidy->clean( $evt->{'subject'} );
4638             $t->[1]  = $tidy->clean( $t->[1] );
4639         }
4640
4641         if ($req->{'lineendings'} eq "unix") {
4642             # do nothing.  native format.
4643         }
4644         elsif ($req->{'lineendings'} eq "mac") {
4645             $t->[1] =~ s/\n/\r/g;
4646         }
4647         elsif ($req->{'lineendings'} eq "space") {
4648             $t->[1] =~ s/\n/ /g;
4649         }
4650         elsif ($req->{'lineendings'} eq "dots") {
4651             $t->[1] =~ s/\n/ ... /g;
4652         }
4653         else { # "pc" -- default
4654             $t->[1] =~ s/\n/\r\n/g;
4655         }
4656
4657         $evt->{'event'} = $t->[1];
4658     }
4659
4660     # maybe we don't need the props after all
4661     if ($req->{'noprops'}) {
4662         foreach(@$events) { delete $_->{'props'}; }
4663     }
4664
4665     return $res;
4666 }
4667
4668 sub createrepost {
4669     my ($req, $err, $flags) = @_;
4670     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'createrepost');
4671
4672     my $u = $flags->{'u'};
4673
4674     my $timezone = $req->{'tz'} || 'guess';
4675     unless ($timezone eq 'guess' ||
4676             $timezone =~ /^[+\-]\d\d\d\d$/) {
4677         return fail($err, 203, 'xmlrpc.des.bad_value', {'param'=>'tz'});
4678     }
4679
4680     my $url   = $req->{'url'} || return fail($err,200,"url");
4681     my $entry = LJ::Entry->new_from_url($url);
4682
4683     return fail($err, 203, 'url') unless $entry && $entry->valid;
4684     return fail($err, 227) unless $entry->visible_to($u);
4685
4686     my $result = LJ::Entry::Repost->create(  $u, # destination journal
4687                                              $entry, # entry to be reposted
4688                                              $timezone, # timezone for repost
4689                                              );
4690
4691     if ( my $error = $result->{error} ) {
4692         return fail($err, 228, $error->{error_message});
4693     }
4694
4695     $result->{result}{status} = 'OK';
4696
4697     return $result->{result};
4698 }
4699
4700 sub deleterepost {
4701     my ($req, $err, $flags) = @_;
4702     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'deleterepost');
4703
4704     my $u = $flags->{'u'};
4705
4706     my $url   = $req->{'url'} || return fail($err,200,"url");
4707     my $entry = LJ::Entry->new_from_url($url);
4708
4709     return fail($err, 203, 'url') unless $entry && $entry->valid;
4710
4711     my $result = LJ::Entry::Repost->delete(  $u, # destination journal
4712                                              $entry,); # entry to be reposted
4713
4714     if ( my $error = $result->{error} ) {
4715         return fail($err, 229, $error->{error_message});
4716     }
4717
4718     $result->{status} = 'OK';
4719
4720     return $result;
4721 }
4722
4723 sub getrepoststatus {
4724     my ($req, $err, $flags) = @_;
4725
4726     $flags->{allow_anonymous} = 1;
4727     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getevents');
4728
4729     my $u = $flags->{'u'};
4730
4731     my $url   = $req->{'url'} || return fail($err,200,"url");
4732     my $entry = LJ::Entry->new_from_url($url);
4733
4734     return fail($err, 203, 'url') unless $entry && $entry->valid;
4735     return fail($err, 227) unless $entry->visible_to($u);
4736
4737     my $result = LJ::Entry::Repost->get_status($entry, $u);
4738
4739     $result->{status} = 'OK';
4740
4741     return $result;
4742 }
4743
4744 sub editfriends
4745 {
4746     my ($req, $err, $flags) = @_;
4747     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'editfriends');
4748
4749     my $u = $flags->{'u'};
4750     my $userid = $u->{'userid'};
4751     my $dbh = LJ::get_db_writer();
4752     my $sth;
4753
4754     return fail($err,306) unless $dbh;
4755
4756     # do not let locked people do this
4757     return fail($err, 308) if $u->{statusvis} eq 'L';
4758
4759 #
4760 # Do not have values for $LJ::ADD_FRIEND_RATE_LIMIT
4761 #
4762 #    # check action frequency
4763 #    unless ($flags->{no_rate_check}){
4764 #        my $cond = ["ratecheck:add_friend:$userid",
4765 #                    [ $LJ::ADD_FRIEND_RATE_LIMIT || [ 10, 600 ] ]
4766 #                   ];
4767 #        return fail($err, 411)
4768 #            unless LJ::RateLimit->check($u, [ $cond ]);
4769 #    }
4770
4771     my $res = {
4772         xc3 => {
4773             u => $u
4774         }
4775     };
4776
4777     ## first, figure out who the current friends are to save us work later
4778     my %curfriend;
4779     my $friend_count = 0;
4780     my $friends_changed = 0;
4781
4782     # TAG:FR:protocol:editfriends1
4783     $sth = $dbh->prepare("SELECT u.user FROM useridmap u, friends f ".
4784                          "WHERE u.userid=f.friendid AND f.userid=$userid");
4785     $sth->execute;
4786     while (my ($friend) = $sth->fetchrow_array) {
4787         $curfriend{$friend} = 1;
4788         $friend_count++;
4789     }
4790     $sth->finish;
4791
4792     # perform the deletions
4793   DELETEFRIEND:
4794     foreach (@{$req->{'delete'}})
4795     {
4796         my $deluser = LJ::canonical_username($_);
4797         next DELETEFRIEND unless ($curfriend{$deluser});
4798
4799         my $friendid = LJ::get_userid($deluser);
4800         # TAG:FR:protocol:editfriends2_del
4801         LJ::remove_friend($userid, $friendid);
4802         $friend_count--;
4803         $friends_changed = 1;
4804     }
4805
4806     my $error_flag = 0;
4807     my $friends_added = 0;
4808     my $fail = sub {
4809         LJ::memcache_kill($userid, "friends");
4810         LJ::mark_dirty($userid, "friends");
4811         return fail($err, $_[0], $_[1]);
4812     };
4813
4814     # only people, shared journals, and owned syn feeds can add friends
4815     return $fail->(104, 'xmlrpc.des.friends_add_not_allowed')
4816         unless ($u->{'journaltype'} eq 'P' ||
4817                 $u->{'journaltype'} eq 'S' ||
4818                 $u->{'journaltype'} eq 'I' ||
4819                 ($u->{'journaltype'} eq "Y" && $u->password));
4820
4821     # Don't let suspended users add friend
4822     return $fail->(305, 'xmlrpc.des.suspended_add_friend')
4823         if ($u->is_suspended);
4824
4825      my $sclient = LJ::theschwartz();
4826
4827     # perform the adds
4828   ADDFRIEND:
4829     foreach my $fa (@{$req->{'add'}})
4830     {
4831         unless (ref $fa eq "HASH") {
4832             $fa = { 'username' => $fa };
4833         }
4834
4835         my $aname = LJ::canonical_username($fa->{'username'});
4836         unless ($aname) {
4837             $error_flag = 1;
4838             next ADDFRIEND;
4839         }
4840
4841         $friend_count++ unless $curfriend{$aname};
4842
4843         my $err;
4844         return $fail->(104, "$err")
4845             unless $u->can_add_friends(\$err, { 'numfriends' => $friend_count, friend => $fa });
4846
4847         my $fg = $fa->{'fgcolor'} || "#000000";
4848         my $bg = $fa->{'bgcolor'} || "#FFFFFF";
4849         if ($fg !~ /^\#[0-9A-F]{6,6}$/i || $bg !~ /^\#[0-9A-F]{6,6}$/i) {
4850             return $fail->(203, 'xmlrpc.des.bad_value',{'param'=>'color'});
4851         }
4852
4853         my $row = LJ::load_user($aname);
4854         my $currently_is_friend = LJ::is_friend($u, $row);
4855         my $currently_is_banned = LJ::is_banned($u, $row);
4856
4857         # XXX - on some errors we fail out, on others we continue and try adding
4858         # any other users in the request. also, error message for redirect should
4859         # point the user to the redirected username.
4860         if (! $row) {
4861             $error_flag = 1;
4862         } elsif ($row->{'journaltype'} eq "R") {
4863             return $fail->(154);
4864         } elsif ($row->{'statusvis'} ne "V") {
4865             $error_flag = 1;
4866         } else {
4867             $friends_added++;
4868             my $added = { 'username'    => $aname,
4869                           'fullname'    => $row->{'name'},
4870                           'journaltype' => $row->{journaltype},
4871                           'defaultpicurl' => ($row->{'defaultpicid'} && "$LJ::USERPIC_ROOT/$row->{'defaultpicid'}/$row->{'userid'}"),
4872                           'fgcolor'     => $fg,
4873                           'bgcolor'     => $bg,
4874                       };
4875             if ($req->{'ver'} >= 1) {
4876                 LJ::text_out(\$added->{'fullname'});
4877             }
4878
4879             if ($row->identity) {
4880                 my $i = $row->identity;
4881                 $added->{'identity_type'} = $i->pretty_type;
4882                 $added->{'identity_value'} = $i->value;
4883                 $added->{'identity_url'} = $i->url($row);
4884                 $added->{'identity_display'} = $row->display_name;
4885             }
4886             $added->{"type"} = {
4887                 'C' => 'community',
4888                 'Y' => 'syndicated',
4889                 'N' => 'news',
4890                 'S' => 'shared',
4891                 'I' => 'identity',
4892             }->{$row->{'journaltype'}} if $row->{'journaltype'} ne 'P';
4893
4894             my $qfg = LJ::color_todb($fg);
4895             my $qbg = LJ::color_todb($bg);
4896
4897             my $friendid = $row->{'userid'};
4898
4899             my $gmask = $fa->{'groupmask'};
4900             if (! $gmask && $curfriend{$aname}) {
4901                 # if no group mask sent, use the existing one if this is an existing friend
4902                 # TAG:FR:protocol:editfriends3_getmask
4903                 my $sth = $dbh->prepare("SELECT groupmask FROM friends ".
4904                                         "WHERE userid=$userid AND friendid=$friendid");
4905                 $sth->execute;
4906                 $gmask = $sth->fetchrow_array;
4907             }
4908             # force bit 0 on.
4909             $gmask |= 1;
4910
4911             $added->{groupmask} = $gmask;
4912             push @{$res->{'added'}}, $added;
4913
4914             # TAG:FR:protocol:editfriends4_addeditfriend
4915             my $cnt = $dbh->do("REPLACE INTO friends (userid, friendid, fgcolor, bgcolor, groupmask) ".
4916                                "VALUES ($userid, $friendid, $qfg, $qbg, $gmask)");
4917             return $fail->(501,$dbh->errstr) if $dbh->err;
4918
4919             if ($cnt == 1) {
4920                 LJ::run_hooks('befriended', LJ::load_userid($userid), LJ::load_userid($friendid));
4921                 LJ::User->increase_friendsof_counter($friendid);
4922             }
4923
4924             my $memkey = [$userid,"frgmask:$userid:$friendid"];
4925             LJ::MemCacheProxy::set($memkey, $gmask+0, time()+60*15);
4926             LJ::memcache_kill($friendid, 'friendofs');
4927             LJ::memcache_kill($friendid, 'friendofs2');
4928
4929             if ($sclient && !$currently_is_friend && !$currently_is_banned) {
4930
4931                 # For Profile
4932                 my $friender = LJ::load_userid($userid);
4933                 my $friendee = LJ::load_userid($friendid);
4934
4935                 $friender->clear_cache_friends($friendee);
4936
4937                 ## delay event to accumulate users activity
4938                 require LJ::Event::BefriendedDelayed;
4939                 LJ::Event::BefriendedDelayed->send(
4940                                                     $friendee,  ## to user
4941                                                     $friender   ## from user
4942                                                     );
4943                 my @jobs;
4944                 push @jobs, TheSchwartz::Job->new(
4945                                                   funcname => "LJ::Worker::FriendChange",
4946                                                   arg      => [$userid, 'add', $friendid],
4947                                                   ) unless $LJ::DISABLED{'friendchange-schwartz'};
4948
4949                 $sclient->insert_jobs(@jobs) if @jobs;
4950             }
4951             $friends_changed = 1;
4952         }
4953     }
4954
4955     return $fail->(104) if $error_flag;
4956
4957     # invalidate memcache of friends
4958     LJ::memcache_kill($userid, "friends");
4959     LJ::memcache_kill($userid, "friends2");
4960     LJ::mark_dirty($userid, "friends");
4961
4962     LJ::run_hooks('friends_changed', LJ::load_userid($userid)) if $friends_changed;
4963
4964     return $res;
4965 }
4966
4967 sub editfriendgroups
4968 {
4969     my ($req, $err, $flags) = @_;
4970     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'editfriendgroups');
4971
4972     my $u = $flags->{'u'};
4973     my $userid = $u->{'userid'};
4974     my ($db, $fgtable, $bmax, $cmax) = $u->{dversion} > 5 ?
4975                          ($u->writer, 'friendgroup2', LJ::BMAX_GRPNAME2, LJ::CMAX_GRPNAME2) :
4976                          (LJ::get_db_writer(), 'friendgroup', LJ::BMAX_GRPNAME, LJ::CMAX_GRPNAME);
4977     my $sth;
4978
4979     return fail($err,306) unless $db;
4980
4981     # do not let locked people do this
4982     return fail($err, 308) if $u->{statusvis} eq 'L';
4983
4984     my $res = {};
4985
4986     ## make sure tree is how we want it
4987     $req->{'groupmasks'} = {} unless
4988         (ref $req->{'groupmasks'} eq "HASH");
4989     $req->{'set'} = {} unless
4990         (ref $req->{'set'} eq "HASH");
4991     $req->{'delete'} = [] unless
4992         (ref $req->{'delete'} eq "ARRAY");
4993
4994     # Keep track of what bits are already set, so we can know later
4995     # whether to INSERT or UPDATE.
4996     my %bitset;
4997     my $groups = LJ::get_friend_group($userid);
4998     foreach my $bit (keys %{$groups || {}}) {
4999         $bitset{$bit} = 1;
5000     }
5001
5002     ## before we perform any DB operations, validate input text
5003     # (groups' names) for correctness so we can fail gracefully
5004     if ($LJ::UNICODE) {
5005         foreach my $bit (keys %{$req->{'set'}})
5006         {
5007             my $name = $req->{'set'}->{$bit}->{'name'};
5008             return fail($err,207,'xmlrpc.des.not_ascii')
5009                 if $req->{'ver'} < 1 and not LJ::is_ascii($name);
5010             return fail($err,208,'xmlrpc.des.invalid_group',{'siteroot'=>$LJ::SITEROOT})
5011                 unless LJ::text_in($name);
5012         }
5013     }
5014
5015     ## figure out deletions we'll do later
5016     foreach my $bit (@{$req->{'delete'}})
5017     {
5018         $bit += 0;
5019         next unless ($bit >= 1 && $bit <= 30);
5020         $bitset{$bit} = 0;  # so later we replace into, not update.
5021     }
5022
5023     ## do additions/modifications ('set' hash)
5024     my %added;
5025     foreach my $bit (keys %{$req->{'set'}})
5026     {
5027         $bit += 0;
5028         next unless ($bit >= 1 && $bit <= 30);
5029         my $sa = $req->{'set'}->{$bit};
5030         my $name = LJ::text_trim($sa->{'name'}, $bmax, $cmax);
5031
5032         # can't end with a slash
5033         $name =~ s!/$!!;
5034
5035         # setting it to name is like deleting it.
5036         unless ($name =~ /\S/) {
5037             push @{$req->{'delete'}}, $bit;
5038             next;
5039         }
5040
5041         my $qname = $db->quote($name);
5042         my $qsort = defined $sa->{'sort'} ? ($sa->{'sort'}+0) : 50;
5043         my $qpublic = $db->quote(defined $sa->{'public'} ? ($sa->{'public'}+0) : 0);
5044
5045         if ($bitset{$bit}) {
5046             # so update it
5047             my $sets;
5048             if (defined $sa->{'public'}) {
5049                 $sets .= ", is_public=$qpublic";
5050             }
5051             $db->do("UPDATE $fgtable SET groupname=$qname, sortorder=$qsort ".
5052                     "$sets WHERE userid=$userid AND groupnum=$bit");
5053         } else {
5054             $db->do("REPLACE INTO $fgtable (userid, groupnum, ".
5055                     "groupname, sortorder, is_public) VALUES ".
5056                     "($userid, $bit, $qname, $qsort, $qpublic)");
5057         }
5058         $added{$bit} = 1;
5059     }
5060
5061
5062     ## do deletions ('delete' array)
5063     my $dbcm = LJ::get_cluster_master($u);
5064
5065     # ignore bits that aren't integers or that are outside 1-30 range
5066     my @delete_bits = grep {$_ >= 1 and $_ <= 30} map {$_+0} @{$req->{'delete'}};
5067     my $delete_mask = 0;
5068     foreach my $bit (@delete_bits) {
5069         $delete_mask |= (1 << $bit)
5070     }
5071
5072     # remove the bits for deleted groups from all friends groupmasks
5073     my $dbh = LJ::get_db_writer();
5074     if ($delete_mask) {
5075         # TAG:FR:protocol:editfriendgroups_removemasks
5076         $dbh->do("UPDATE friends".
5077                  "   SET groupmask = groupmask & ~$delete_mask".
5078                  " WHERE userid = $userid");
5079     }
5080
5081     foreach my $bit (@delete_bits)
5082     {
5083         # remove all posts from allowing that group:
5084         my @posts_to_clean = ();
5085         $sth = $dbcm->prepare("SELECT jitemid FROM logsec2 WHERE journalid=$userid AND allowmask & (1 << $bit)");
5086         $sth->execute;
5087         while (my ($id) = $sth->fetchrow_array) { push @posts_to_clean, $id; }
5088         while (@posts_to_clean) {
5089             my @batch;
5090             if (scalar(@posts_to_clean) < 20) {
5091                 @batch = @posts_to_clean;
5092                 @posts_to_clean = ();
5093             } else {
5094                 @batch = splice(@posts_to_clean, 0, 20);
5095             }
5096
5097             my $in = join(",", @batch);
5098             LJ::run_hooks('report_entry_update', $userid, \@batch);
5099             $u->do("UPDATE log2 SET allowmask=allowmask & ~(1 << $bit) ".
5100                    "WHERE journalid=$userid AND jitemid IN ($in) AND security='usemask'");
5101             $u->do("UPDATE logsec2 SET allowmask=allowmask & ~(1 << $bit) ".
5102                    "WHERE journalid=$userid AND jitemid IN ($in)");
5103
5104             foreach my $id (@batch) {
5105                 LJ::MemCache::delete([$userid, "log2:$userid:$id"]);
5106             }
5107             LJ::MemCache::delete([$userid, "log2lt:$userid"]);
5108         }
5109         LJ::Tags::deleted_friend_group($u, $bit);
5110         LJ::run_hooks('delete_friend_group', $u, $bit);
5111
5112         # remove the friend group, unless we just added it this transaction
5113         unless ($added{$bit}) {
5114             $db->do("DELETE FROM $fgtable WHERE ".
5115                     "userid=$userid AND groupnum=$bit");
5116         }
5117     }
5118
5119     ## change friends' masks
5120     # TAG:FR:protocol:editfriendgroups_changemasks
5121     foreach my $friend (keys %{$req->{'groupmasks'}})
5122     {
5123         my $mask = int($req->{'groupmasks'}->{$friend}) | 1;
5124         my $friendid = LJ::get_userid($friend);
5125
5126         $dbh->do("UPDATE friends SET groupmask=$mask ".
5127                  "WHERE userid=$userid AND friendid=?",
5128                  undef, $friendid);
5129         LJ::MemCacheProxy::set([$userid, "frgmask:$userid:$friendid"], $mask);
5130     }
5131
5132     # invalidate memcache of friends/groups
5133     LJ::memcache_kill($userid, "friends");
5134     LJ::memcache_kill($userid, "fgrp");
5135     LJ::mark_dirty($u, "friends");
5136
5137     # return value for this is nothing.
5138     return {
5139         xc3 => {
5140             u => $u
5141         }
5142     };
5143 }
5144
5145 sub sessionexpire {
5146     my ($req, $err, $flags) = @_;
5147     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'sessionexpire');
5148     my $u = $flags->{u};
5149     my $res = {
5150         xc3 => {
5151             u => $u
5152         }
5153     };
5154
5155     # expunge one? or all?
5156     if ($req->{expireall}) {
5157         $u->kill_all_sessions;
5158         return $res;
5159     }
5160
5161     # just expire a list
5162     my $list = $req->{expire} || [];
5163
5164     return $res unless @$list;
5165
5166     return fail($err,502) unless $u->writer;
5167     $u->kill_sessions(@$list);
5168
5169     return $res;
5170 }
5171
5172 sub sessiongenerate {
5173     # generate a session
5174     my ($req, $err, $flags) = @_;
5175     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'sessiongenerate');
5176
5177     # sanitize input
5178     $req->{expiration} = 'short' unless $req->{expiration} eq 'long';
5179     my $boundip;
5180     $boundip = LJ::get_remote_ip() if $req->{bindtoip};
5181
5182     my $u = $flags->{u};
5183     my $sess_opts = {
5184         exptype => $req->{expiration},
5185         ipfixed => $boundip,
5186     };
5187
5188     # do not let locked people do this
5189     return fail($err, 308) if $u->{statusvis} eq 'L';
5190
5191     my $sess = LJ::Session->create($u, %$sess_opts);
5192
5193     # return our hash
5194     return {
5195         ljsession => $sess->master_cookie_string,
5196         xc3 => {
5197             u => $u
5198         }
5199     };
5200 }
5201
5202 sub list_friends {
5203     my ($u, $opts) = @_;
5204
5205     # do not show people in here
5206     my %hide;  # userid -> 1
5207
5208     # TAG:FR:protocol:list_friends
5209     my $sql;
5210
5211     unless ($opts->{'friendof'}) {
5212         $sql = "SELECT friendid, fgcolor, bgcolor, groupmask FROM friends WHERE userid=?";
5213     }
5214     else {
5215         $sql = "SELECT userid FROM friends WHERE friendid=?";
5216
5217         if (my $list = LJ::load_rel_user($u, 'B')) {
5218             $hide{$_} = 1 foreach @$list;
5219         }
5220     }
5221
5222     my $dbr = LJ::get_db_reader();
5223     my $sth = $dbr->prepare($sql);
5224     $sth->execute($u->{'userid'});
5225
5226     my @frow;
5227
5228     while (my @row = $sth->fetchrow_array) {
5229         next if $hide{$row[0]};
5230         push @frow, [ @row ];
5231     }
5232
5233     my $us = LJ::load_userids(map { $_->[0] } @frow);
5234     my $limitnum = $opts->{'limit'}+0;
5235
5236     my $res = [];
5237
5238     foreach my $f (sort { $us->{$a->[0]}{'user'} cmp $us->{$b->[0]}{'user'} }
5239                    grep { $us->{$_->[0]} } @frow)
5240     {
5241         my $u = $us->{$f->[0]};
5242         next if $opts->{'friendof'} && $u->{'statusvis'} ne 'V';
5243
5244         my $r = {
5245             'username' => $u->{'user'},
5246             'fullname' => $u->{'name'},
5247         };
5248
5249
5250         if ($u->identity) {
5251             my $i = $u->identity;
5252             $r->{'identity_type'}    = $i->pretty_type;
5253             $r->{'identity_value'}   = $i->value;
5254             $r->{'identity_url'} = $i->url($u);
5255             $r->{'identity_display'} = $u->display_name;
5256         }
5257
5258         if ($opts->{'includebdays'} &&
5259             $u->{'bdate'} &&
5260             $u->{'bdate'} ne "0000-00-00" &&
5261             $u->can_show_full_bday)
5262         {
5263             $r->{'birthday'} = $u->{'bdate'};
5264         }
5265
5266         unless ($opts->{'friendof'}) {
5267             $r->{'fgcolor'}   = LJ::color_fromdb($f->[1]);
5268             $r->{'bgcolor'}   = LJ::color_fromdb($f->[2]);
5269             $r->{'groupmask'} = $f->[3] if $f->[3] != 1;
5270         }
5271         else {
5272             $r->{'fgcolor'} = "#000000";
5273             $r->{'bgcolor'} = "#ffffff";
5274         }
5275
5276         $r->{"type"} = {
5277             'C' => 'community',
5278             'Y' => 'syndicated',
5279             'N' => 'news',
5280             'S' => 'shared',
5281             'I' => 'identity',
5282         }->{$u->{'journaltype'}} if $u->{'journaltype'} ne 'P';
5283
5284         $r->{"status"} = {
5285             'D' => "deleted",
5286             'S' => "suspended",
5287             'X' => "purged",
5288         }->{$u->{'statusvis'}} if $u->{'statusvis'} ne 'V';
5289
5290         $r->{defaultpicurl} = "$LJ::USERPIC_ROOT/$u->{'defaultpicid'}/$u->{'userid'}" if $u->{'defaultpicid'};
5291
5292         push @$res, $r;
5293
5294         # won't happen for zero limit (which means no limit)
5295         last if @$res == $limitnum;
5296     }
5297
5298     return $res;
5299 }
5300
5301 sub syncitems {
5302     my ($req, $err, $flags) = @_;
5303     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'syncitems');
5304     return undef unless check_altusage($req, $err, $flags);
5305     return fail($err, 506) if $LJ::DISABLED{'syncitems'};
5306
5307     my $ownerid = $flags->{'ownerid'};
5308     my $uowner  = $flags->{'u_owner'} || $flags->{'u'};
5309     my $sth;
5310
5311     my $db = LJ::get_cluster_reader($uowner);
5312     return fail($err, 502) unless $db;
5313
5314     ## have a valid date?
5315     my $date = $req->{'lastsync'};
5316
5317     if ($date) {
5318         return fail($err, 203, 'xmlrpc.des.bad_value', {'param'=>'date'})
5319             unless ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
5320     } else {
5321         $date = "0000-00-00 00:00:00";
5322     }
5323
5324     my $LIMIT = 500;
5325     my $type = $req->{type} || 'posted';
5326     my ( $table, $idfield ) = ( '', 'jitemid');
5327
5328     my $external_ids = $req->{'use_external_ids'};
5329
5330     if ( $req->{ver} > 3 && LJ::is_enabled("delayed_entries") ) {
5331         if ( $type eq 'posted' ) {
5332             $table   = '';
5333             $idfield = 'jitemid';
5334         }
5335         elsif ( $type eq 'delayed' ) {
5336             $table = 'delayed';
5337             $idfield = 'delayedid';
5338         } else {
5339             return fail( $err, 216 );
5340         }
5341     }
5342
5343     my %item;
5344     $sth = $db->prepare("SELECT ${idfield}, logtime FROM ${table}log2 WHERE ".
5345                         "journalid=? and logtime > ?");
5346     $sth->execute($ownerid, $date);
5347     while (my ($id, $dt, $anum) = $sth->fetchrow_array) {
5348         $item{$id} = [ 'L', $id, $dt, "create", $anum ];
5349     }
5350
5351     my %cmt;
5352
5353     unless ( $type eq 'delayed' ) {
5354         my $p_calter  = LJ::get_prop("log", "commentalter");
5355         my $p_revtime = LJ::get_prop("log", "revtime");
5356         $sth = $db->prepare("SELECT jitemid, propid, FROM_UNIXTIME(value) ".
5357                         "FROM logprop2 WHERE journalid=? ".
5358                         "AND propid IN ($p_calter->{'id'}, $p_revtime->{'id'}) ".
5359                         "AND value+0 > UNIX_TIMESTAMP(?)");
5360
5361          $sth->execute($ownerid, $date);
5362          while (my ($id, $prop, $dt) = $sth->fetchrow_array) {
5363             my $entry = LJ::Entry->new($ownerid, jitemid => $id);
5364
5365             ## sometimes there is no row in log2 table, while there are rows in logprop2
5366             ## it's either corrupted db (replication/failover problem) or lazy/slow deletion of an entry
5367             ## calling $entry->anum on such an entry is a fatal error
5368             next unless $entry && $entry->valid;
5369
5370             if ($prop == $p_calter->{'id'}) {
5371                 $cmt{$id} = [ 'C', $id, $dt, "update", $entry->anum ];
5372             } elsif ($prop == $p_revtime->{'id'}) {
5373                 $item{$id} = [ 'L', $id, $dt, "update", $entry->anum ];
5374             }
5375         }
5376     }
5377     my @ev = sort { $a->[2] cmp $b->[2] } (values %item, values %cmt);
5378
5379     my $res = {
5380         xc3 => {
5381             u => $flags->{'u'}
5382         }
5383     };
5384
5385     my $list = $res->{'syncitems'} = [];
5386     $res->{'total'} = scalar @ev;
5387     my $ct = 0;
5388
5389     while (my $ev = shift @ev) {
5390         $ct++;
5391         push @$list, {
5392             'item'   => "$ev->[0]-$ev->[1]",
5393             'time'   => $ev->[2],
5394             'action' => $ev->[3],
5395             ( $external_ids ? (ditemid => $ev->[1]*256 + $ev->[4]) : () )
5396         };
5397         last if $ct >= $LIMIT;
5398     }
5399
5400     $res->{'count'} = $ct;
5401
5402     return $res;
5403 }
5404
5405 sub consolecommand {
5406     my ($req, $err, $flags) = @_;
5407
5408     # logging in isn't necessary, but most console commands do require it
5409     LJ::set_remote($flags->{'u'}) if authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'consolecommand');
5410
5411     my $res = {
5412         xc3 => {
5413             u => $flags->{'u'}
5414         }
5415     };
5416     my $cmdout = $res->{'results'} = [];
5417
5418     require LJ::Console;
5419     foreach my $cmd (@{$req->{'commands'}}) {
5420         # callee can pre-parse the args, or we can do it bash-style
5421         my @args = ref $cmd eq "ARRAY" ? @$cmd
5422                                        : LJ::Console->parse_line($cmd);
5423         my $c = LJ::Console->parse_array(@args);
5424         my $rv = $c->execute_safely;
5425
5426         my @output;
5427         push @output, [$_->status, $_->text] foreach $c->responses;
5428
5429         push @{$cmdout}, {
5430             'success' => $rv,
5431             'output' => \@output,
5432         };
5433     }
5434
5435     return $res;
5436 }
5437
5438 sub getchallenge
5439 {
5440     my ($req, $err, $flags) = @_;
5441     my $res = {};
5442     my $now = time();
5443     my $etime = 60;
5444     return {
5445         challenge   => LJ::challenge_generate($etime),
5446         server_time => $now,
5447         expire_time => $now + $etime,
5448         auth_scheme => "c0",  # fixed for now, might support others later
5449         xc3         => {}
5450     };
5451 }
5452
5453 sub login_message
5454 {
5455     my ($req, $res, $flags) = @_;
5456     my $u = $flags->{'u'};
5457
5458     my $msg = sub {
5459         my $code = shift;
5460         my $args = shift || {};
5461         $args->{'sitename'} = $LJ::SITENAME;
5462         $args->{'siteroot'} = $LJ::SITEROOT;
5463         my $pre = delete $args->{'pre'};
5464         $res->{'message'} = $pre . translate($u, $code, $args);
5465     };
5466
5467     return $msg->("readonly")          if LJ::get_cap($u, "readonly");
5468     return $msg->("not_validated")     if ($u->{'status'} eq "N" and not $LJ::EVERYONE_VALID);
5469     return $msg->("must_revalidate")   if ($u->{'status'} eq "T" and not $LJ::EVERYONE_VALID);
5470
5471     return $msg->("old_win32_client")  if $req->{'clientversion'} =~ /^Win32-MFC\/(1.2.[0123456])$/;
5472     return $msg->("old_win32_client")  if $req->{'clientversion'} =~ /^Win32-MFC\/(1.3.[01234])\b/;
5473     return $msg->("hello_test")        if grep { $u->{user} eq $_ } @LJ::TESTACCTS;
5474 }
5475
5476 sub list_friendgroups
5477 {
5478     my $u = shift;
5479
5480     # get the groups for this user, return undef if error
5481     my $groups = LJ::get_friend_group($u);
5482     return undef unless $groups;
5483
5484     # we got all of the groups, so put them into an arrayref sorted by the
5485     # group sortorder; also note that the map is used to construct a new hashref
5486     # out of the old group hashref so that we have all of the field names converted
5487     # to a format our callers can recognize
5488     my @res = map { { id => $_->{groupnum},      name => $_->{groupname},
5489                       public => $_->{is_public}, sortorder => $_->{sortorder}, } }
5490               sort { $a->{sortorder} <=> $b->{sortorder} }
5491               values %$groups;
5492
5493     return \@res;
5494 }
5495
5496 sub list_usejournals {
5497     my $u = shift;
5498
5499     my @us = $u->posting_access_list;
5500     my @unames = map { $_->{user} } @us;
5501
5502     return \@unames;
5503 }
5504
5505 sub hash_menus
5506 {
5507     my $u = shift;
5508     my $user = $u->{'user'};
5509
5510     my $menu = [
5511                 { 'text' => "Recent Entries",
5512                   'url' => "$LJ::SITEROOT/users/$user/", },
5513                 { 'text' => "Calendar View",
5514                   'url' => "$LJ::SITEROOT/users/$user/calendar", },
5515                 { 'text' => "Friends View",
5516                   'url' => "$LJ::SITEROOT/users/$user/friends", },
5517                 { 'text' => "-", },
5518                 { 'text' => "Your Profile",
5519                   'url' => "$LJ::SITEROOT/userinfo.bml?user=$user", },
5520                 { 'text' => "Your To-Do List",
5521                   'url' => "$LJ::SITEROOT/todo/?user=$user", },
5522                 { 'text' => "-", },
5523                 { 'text' => "Change Settings",
5524                   'sub' => [ { 'text' => "Personal Info",
5525                                'url' => "$LJ::SITEROOT/manage/profile/", },
5526                              { 'text' => "Customize Journal",
5527                                'url' =>"$LJ::SITEROOT/customize/", }, ] },
5528                 { 'text' => "-", },
5529                 { 'text' => "Support",
5530                   'url' => "$LJ::SITEROOT/support/", }
5531                 ];
5532
5533     LJ::run_hooks("modify_login_menu", {
5534         'menu' => $menu,
5535         'u' => $u,
5536         'user' => $user,
5537     });
5538
5539     return $menu;
5540 }
5541
5542 sub list_pickws
5543 {
5544     my $u = shift;
5545
5546     my $pi = LJ::get_userpic_info($u);
5547     my @res;
5548
5549     my %seen;  # mashifiedptr -> 1
5550
5551     # FIXME: should be a utf-8 sort
5552     foreach my $kw (sort keys %{$pi->{'kw'}}) {
5553         my $pic = $pi->{'kw'}{$kw};
5554         $seen{$pic} = 1;
5555         next if $pic->{'state'} eq "I";
5556         push @res, [ $kw, $pic->{'picid'} ];
5557     }
5558
5559     # now add all the pictures that don't have a keyword
5560     foreach my $picid (keys %{$pi->{'pic'}}) {
5561         my $pic = $pi->{'pic'}{$picid};
5562         next if $seen{$pic};
5563         push @res, [ "pic#$picid", $picid ];
5564     }
5565
5566     return \@res;
5567 }
5568
5569 sub list_moods
5570 {
5571     my $mood_max = int(shift);
5572     LJ::load_moods();
5573
5574     my $res = [];
5575     return $res if $mood_max >= $LJ::CACHED_MOOD_MAX;
5576
5577     for (my $id = $mood_max+1; $id <= $LJ::CACHED_MOOD_MAX; $id++) {
5578         next unless defined $LJ::CACHE_MOODS{$id};
5579         my $mood = $LJ::CACHE_MOODS{$id};
5580         next unless $mood->{'name'};
5581         push @$res, { 'id' => $id,
5582                       'name' => $mood->{'name'},
5583                       'parent' => $mood->{'parent'} };
5584     }
5585
5586     return $res;
5587 }
5588
5589 sub check_altusage
5590 {
5591     my ($req, $err, $flags) = @_;
5592
5593     # see note in LJ::can_use_journal about why we return
5594     # both 'ownerid' and 'u_owner' in $flags
5595
5596     my $alt = $req->{'usejournal'} || $req->{'journal'};
5597     my $u = $flags->{'u'};
5598
5599     unless ($u) {
5600         my $username = $req->{'username'};
5601         if ($username) {
5602             my $dbr = LJ::get_db_reader();
5603             return fail($err,502) unless $dbr;
5604             $u = $flags->{'u'} = LJ::load_user($username);
5605          } else {
5606             if ($flags->{allow_anonymous}) {
5607                 return fail($err,200) unless $alt;
5608                 my $uowner = LJ::load_user($alt);
5609                 return fail($err,206) unless $uowner;
5610                 $flags->{'u_owner'} = $uowner;
5611                 $flags->{'ownerid'} = $uowner->{'userid'};
5612                 return 1;
5613             }
5614             return fail($err,200);
5615         }
5616     }
5617
5618     $flags->{'ownerid'} = $u->{'userid'};
5619
5620     # all good if not using an alt journal
5621     return 1 unless $alt;
5622
5623     # complain if the username is invalid
5624     my $uowner = LJ::load_user($alt);
5625     return fail($err,206) unless $uowner;
5626
5627     # allow usage if we're told explicitly that it's okay
5628     if ($flags->{'usejournal_okay'}) {
5629         $flags->{'u_owner'} = $uowner;
5630         $flags->{'ownerid'} = $uowner->{'userid'};
5631         LJ::Request->notes("journalid" => $flags->{'ownerid'}) if LJ::Request->is_inited && !LJ::Request->notes("journalid");
5632         return 1;
5633     }
5634
5635     # otherwise, check for access:
5636     my $info = {};
5637     my $canuse = LJ::can_use_journal($u->{'userid'}, $alt, $info);
5638     $flags->{'ownerid'} = $info->{'ownerid'};
5639     $flags->{'u_owner'} = $info->{'u_owner'};
5640     LJ::Request->notes("journalid" => $flags->{'ownerid'}) if LJ::Request->is_inited && !LJ::Request->notes("journalid");
5641
5642     return 1 if $canuse || $flags->{'ignorecanuse'};
5643
5644     # not allowed to access it
5645     return fail($err,300);
5646 }
5647
5648 sub authenticate
5649 {
5650     my ($req, $err, $flags) = @_;
5651
5652     my $u;
5653
5654     my $auth_meth = $req->{'auth_method'} || "clear";
5655     my $username  = $req->{'username'} || '';
5656
5657     my $check_user = sub {
5658         return fail($err,100) unless $u;
5659         return fail($err,100) if ($u->{'statusvis'} eq "X");
5660         return fail($err,505) unless $u->{'clusterid'};
5661         return 1;
5662     };
5663
5664     unless ($auth_meth eq "oauth") {
5665
5666         # add flag to avoid authentication
5667         if (!$username && $flags->{'allow_anonymous'}) {
5668             undef $flags->{'u'};
5669             return 1;
5670         }
5671
5672         return fail($err,200) unless $username;
5673         return fail($err,100) unless LJ::canonical_username($username);
5674
5675         $u = $flags->{'u'};
5676         unless ($u) {
5677             my $dbr = LJ::get_db_reader();
5678             return fail($err,502) unless $dbr;
5679             $u = LJ::load_user($username);
5680         }
5681
5682         return unless $check_user->();
5683     }
5684
5685     my $ip_banned = 0;
5686     my $chal_expired = 0;
5687     my $auth_check = sub {
5688
5689         if ($auth_meth eq "clear") {
5690             my $res = LJ::auth_okay($u,
5691                                     $req->{'password'},
5692                                     $req->{'hpassword'},
5693                                     $u->password,
5694                                     \$ip_banned);
5695
5696             if ($res) {
5697                 LJ::Session->record_login($u);
5698             }
5699             return $res;
5700         }
5701         if ($auth_meth eq "challenge") {
5702             my $chal_opts = {};
5703             my $chall_ok = LJ::challenge_check_login($u,
5704                                                      $req->{'auth_challenge'},
5705                                                      $req->{'auth_response'},
5706                                                      \$ip_banned,
5707                                                      $chal_opts);
5708             $chal_expired = 1 if $chal_opts->{expired};
5709             if ($chall_ok && !$chal_opts->{expired}) {
5710                 LJ::Session->record_login($u);
5711             }
5712             return $chall_ok;
5713         }
5714         if ($auth_meth eq "cookie") {
5715             return unless LJ::Request->is_inited && LJ::Request->header_in("X-LJ-Auth") eq "cookie";
5716             my $remote = LJ::get_remote();
5717             return $remote && $remote->{'user'} eq $username ? 1 : 0;
5718         }
5719         if ($auth_meth eq "oauth"){
5720             my $rate_limiter = LJ::Request->is_inited ?
5721               LJ::API::RateLimiter->new(LJ::Request->request) :
5722               LJ::API::RateLimiter->new();
5723
5724             my $oauth = LJ::OAuth->new(rate_limiter => $rate_limiter);
5725
5726             my $result = $oauth->have_access;
5727             unless ($result->{http_status} == 200) {
5728                 return fail($err,331,$result->{oauth_problem}) if $result->{http_status} == 400;
5729                 return fail($err,332,$result->{oauth_problem}) if $result->{http_status} == 401;
5730                 return fail($err,334,$result->{oauth_problem}) if $result->{http_status} == 403;
5731                 return fail($err,413,$result->{oauth_problem}) if $result->{http_status} == 503;
5732                 return fail($err,101);
5733             }
5734             $u = $result->{user};
5735             return unless $check_user->();
5736             $flags->{'user_access'} = $result->{access};
5737             LJ::Session->record_login($u);
5738         }
5739     };
5740
5741     unless ($flags->{'nopassword'} ||
5742             $flags->{'noauth'} ||
5743             $auth_check->() )
5744     {
5745         return undef if $$err;
5746         return fail($err,402) if $ip_banned;
5747         return fail($err,105) if $chal_expired;
5748         return fail($err,101);
5749     }
5750
5751     return 1 if ($flags->{'allow_anonymous'} && !$u);
5752
5753     # if there is a require TOS revision, check for it now
5754     return fail($err, 156) unless $u->tosagree_verify;
5755
5756     # remember the user record for later.
5757     $flags->{'u'} = $u;
5758
5759     if (LJ::Request->is_inited) {
5760         LJ::Request->notes("ljuser" => $u->{'user'}) unless LJ::Request->notes("ljuser");
5761         LJ::Request->notes("journalid" => $u->{'userid'}) unless LJ::Request->notes("journalid");
5762     }
5763
5764     return 1;
5765 }
5766
5767 sub authorize
5768 {
5769     my ($req, $err, $flags, $method) = @_;
5770
5771     my $auth_method = $req->{'auth_method'};
5772
5773     return 1 if ($flags->{noauth} || $flags->{nopassword});
5774
5775     if ($auth_method eq 'oauth') {
5776
5777         return fail($err,333) unless $flags->{'user_access'};
5778         return fail($err,333) unless defined $LJ::XMLRPC_USER_ACCESS{$method};
5779
5780         my $access_required = ref $LJ::XMLRPC_USER_ACCESS{$method} ? $LJ::XMLRPC_USER_ACCESS{$method} : [$LJ::XMLRPC_USER_ACCESS{$method}];
5781
5782         my %user_access = map {$_ => 1} @{$flags->{'user_access'}};
5783
5784         foreach my $p (@$access_required){
5785             return fail($err,333) unless ( $user_access{$p} || ($p =~ /(.+)_ro$/) && $user_access{"$1_rw"} );
5786         }
5787     }
5788
5789     if ($LJ::XMLRPC_VALIDATION_METHOD{$method}) {
5790         # Deny access for accounts that have not validated their email
5791         my $u = $flags->{'u'} || LJ::load_user($req->{'username'});
5792         unless ($u){
5793             return fail($err,335);
5794         }
5795         unless ($u->is_validated) {
5796             return fail($err,336);
5797         }
5798     }
5799
5800     return 1;
5801 }
5802
5803 sub fail
5804 {
5805     my $err  = shift;
5806     my $code = shift;
5807     my $des  = shift;
5808     my $vars = shift;
5809     $code .= ":".($des =~ /^xmlrpc\.des\./ ? LJ::Lang::ml($des, $vars) : $des) if $des;
5810     $$err = $code if (ref $err eq "SCALAR");
5811     return undef;
5812 }
5813
5814 # PROBLEM: a while back we used auto_increment fields in our tables so that we could have
5815 # automatically incremented itemids and such.  this was eventually phased out in favor of
5816 # the more portable alloc_user_counter function which uses the 'counter' table.  when the
5817 # counter table has no data, it finds the highest id already in use in the database and adds
5818 # one to it.
5819 #
5820 # a problem came about when users who last posted before alloc_user_counter went
5821 # and deleted all their entries and posted anew.  alloc_user_counter would find no entries,
5822 # this no ids, and thus assign id 1, thinking it's all clean and new.  but, id 1 had been
5823 # used previously, and now has comments attached to it.
5824 #
5825 # the comments would happen because there was an old bug that wouldn't delete comments when
5826 # an entry was deleted.  this has since been fixed.  so this all combines to make this
5827 # a necessity, at least until no buggy data exist anymore!
5828 #
5829 # this code here removes any comments that happen to exist for the id we're now using.
5830 sub new_entry_cleanup_hack {
5831     my ($u, $jitemid) = @_;
5832
5833     # sanitize input
5834     $jitemid += 0;
5835     return unless $jitemid;
5836     my $ownerid = LJ::want_userid($u);
5837     return unless $ownerid;
5838
5839     # delete logprops
5840     $u->do("DELETE FROM logprop2 WHERE journalid=$ownerid AND jitemid=$jitemid");
5841
5842     # delete comments
5843     my $ids = LJ::Talk::get_talk_data($u, 'L', $jitemid);
5844     return unless ref $ids eq 'HASH' && %$ids;
5845     my $list = join ',', map { $_+0 } keys %$ids;
5846     $u->do("DELETE FROM talk2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
5847     $u->do("DELETE FROM talktext2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
5848     $u->do("DELETE FROM talkprop2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
5849 }
5850
5851 sub un_utf8_request {
5852     my $req = shift;
5853     $req->{$_} = LJ::no_utf8_flag($req->{$_}) foreach qw(subject event);
5854     my $props = $req->{props} || {};
5855     foreach my $k (keys %$props) {
5856         next if ref $props->{$k};  # if this is multiple levels deep?  don't think so.
5857         $props->{$k} = LJ::no_utf8_flag($props->{$k});
5858     }
5859 }
5860
5861 # registerpush: adding push-notification params to user prop
5862 # specific for each mobile platform (windows phone 7, android, iOS)
5863 #
5864 # takes:
5865 # - platform:       wp7 / android / ios
5866 # - registrationid: argument which we use in communication with notification
5867 #                   servers, specific for each OS
5868 # - deviceid:       id of registred device (not use yet)
5869 #
5870 # returns: { status => 'OK'} if success
5871 #
5872 sub registerpush {
5873     my ($req, $err, $flags) = @_;
5874
5875     return undef
5876         unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'registerpush');
5877
5878     my $u = $flags->{u};
5879
5880     return fail($err, 200)
5881         unless $u && $req->{platform} && $req->{deviceid};
5882
5883     my $error = LJ::PushNotification->subscribe($u, $req);
5884     return fail($error, 412) if $error;
5885
5886     return { status => 'OK' }
5887 }
5888
5889 # unregisterpush: deletes subscription on push notification and clears user prop
5890 #                 with notification servers connection arguments
5891 #
5892 # takes:
5893 # - platform: wp7 / android / ios
5894 # - deviceid: id of registred device (not use yet)
5895 #
5896 # returns:  { status => 'OK'} if success
5897 #
5898 sub unregisterpush {
5899     my ($req, $err, $flags) = @_;
5900     return undef
5901         unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'unregisterpush');
5902
5903     my $u = $flags->{u};
5904
5905     return fail($err,200)
5906         unless $req->{platform};
5907
5908     my $error = LJ::PushNotification->unsubscribe($u, $req);
5909     return $error if $error;
5910
5911     return { status => 'OK' };
5912 }
5913
5914 sub pushsubscriptions {
5915     my ($req, $err, $flags) = @_;
5916     return undef
5917         unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'pushsubscriptions');
5918
5919     my $u = $flags->{u};
5920     my @errors;
5921     foreach my $event (@{$req->{events}}) {
5922         if($event->{action} =~ /^(un)?subscribe$/) {
5923
5924             my $res = eval{
5925                 LJ::PushNotification->manage(
5926                     $u,
5927                     app_name        => $req->{app_name},
5928                     platform        => $req->{platform},
5929                     deviceid        => $req->{deviceid},
5930                     optional_data   => $req->{optional_data},
5931                     %$event,
5932                 )
5933             };
5934
5935             push @errors, $@
5936                 if $@;
5937
5938         } else {
5939             push @errors, "wrong action '$event->{action}'";
5940         }
5941     }
5942
5943     return { status => 'Has errors', errors => join "; ", @errors  }
5944         if @errors;
5945
5946     return { status => 'OK' };
5947
5948 }
5949
5950 sub resetpushcounter {
5951     my ($req, $err, $flags) = @_;
5952     return undef
5953         unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'resetpushcounter');
5954
5955     my $u = $flags->{u};
5956
5957     return fail($err,200)
5958         unless $req->{platform} && $req->{deviceid};
5959
5960     return fail($err,200)
5961         if $req->{platform} eq 'android';
5962
5963
5964     if(LJ::PushNotification::Storage->reset_counter($u, $req->{platform}, $req->{deviceid})) {
5965         return { status => 'OK' }
5966     }
5967
5968     return { status => 'Error', error => "Can't reset counter"}
5969
5970 }
5971
5972 sub getpushlist {
5973     my ($req, $err, $flags) = @_;
5974     return undef
5975         unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getpushlist');
5976
5977     my $u = $flags->{u};
5978
5979     return fail($err,200)
5980         unless $req->{platform} && $req->{deviceid};
5981
5982     my @subs = grep { $_->{ntypeid} == LJ::NotificationMethod::Push->ntypeid } ($u->subscriptions);
5983
5984     my @events;
5985     foreach my $s (@subs) {
5986
5987         my ($event) = $s->event_class =~ /LJ::Event::(.*)/;
5988
5989         my $journal = LJ::load_userid($s->{journalid});
5990
5991         my %event = (
5992             event   => $event,
5993         );
5994
5995         $event{journal} = LJ::load_userid($s->{journalid})->user
5996             if $s->{journalid} != $s->{userid};
5997
5998         if($event eq 'JournalNewComment' && $s->arg1) {
5999             $event{ditemid} = $s->arg1;
6000         }
6001
6002         if($event eq 'JournalNewComment' && $s->arg2) {
6003             my $comment = LJ::Comment->instance($s->{journalid}, jtalkid => $s->arg2);
6004             $event{dtalkid} = $comment->dtalkid;
6005         }
6006
6007         push @events, \%event;
6008     }
6009
6010     return {
6011         status  => 'OK',
6012         events  => \@events,
6013     }
6014
6015 }
6016
6017 sub geteventsrating {
6018     my ($req, $err, $flags) = @_;
6019
6020     $flags->{allow_anonymous} = 1;
6021     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'geteventsrating');
6022
6023     my $user_id = $flags->{u} ? $flags->{u}->id : 0;
6024
6025     return fail($err, 200, 'region') unless $req->{region};
6026
6027     return fail($err, 203, 'region') unless $req->{region} =~ /^cyr|noncyr|ua$/;
6028
6029     return fail($err, 203, 'sort') if $req->{sort} &&  $req->{sort} !~ /^hits|visitors|default$/;
6030
6031     foreach my $p (qw(skip itemshow user_id)){
6032         return fail($err, 203, 'xmlrpc.des.non_arifmetic', {'param'=>$p, 'value'=>$req->{$p}}) if ($req->{$p} && $req->{$p} =~ /\D/);
6033         $req->{$p} += 0;
6034     }
6035
6036     return fail($err, 209, 'xmlrpc.des.bad_value', {'param'=>'itemshow'}) if $req->{itemshow} > 100;
6037
6038     $req->{getselfpromo} = 1 unless defined $req->{getselfpromo};
6039
6040     my ($res, @err) = LJ::PersonalStats::Ratings::Posts->get_rating_segment( {
6041         rating_country   => $req->{region},
6042         ($req->{sort} ne 'default' ? (sort => $req->{sort}) : ()),
6043         offset           => $req->{skip} || 0,
6044         length           => $req->{itemshow} || 30,
6045         show_selfpromo   => $req->{getselfpromo},
6046         filter_selfpromo => $req->{getselfpromo},
6047         user_id          => $user_id,
6048     });
6049
6050     return fail($err, 500, $err[0]) unless $res && ref $res && $res->{data} && ref $res->{data};
6051
6052     my (@events, $selfpromo);
6053
6054     my $entry_opts = {
6055         attrs         => [qw(ditemid subject_raw event_raw)],
6056         remote_id     => $user_id,
6057         map { $_ => $req->{$_} } qw(trim_widgets img_length get_video_ids get_polls asxml parseljtags),
6058     };
6059
6060     my $user_opts = {
6061         attrs => [qw(userid username)],
6062     };
6063
6064     foreach my $row (@{$res->{data}}) {
6065         $row->{ditemid}   = delete $row->{post_id} if $row->{post_id};
6066         $row->{journalid} = delete $row->{journal_id} if $row->{journal_id};
6067         LJ::get_aggregated_entry($row, $entry_opts);
6068
6069         $row->{userid} = delete $row->{journalid} if  $row->{journalid};
6070
6071         LJ::get_aggregated_user($row, $user_opts);
6072
6073         push @events, {
6074             # rating data
6075             position     => $row->{position},
6076             delta        => $row->{delta},
6077             isnew        => $row->{is_new} || 0,
6078             was_in_promo => $row->{was_in_promo} || 0,
6079             # entry data
6080             ditemid      => $row->{ditemid},
6081             subject      => $row->{subject_raw},
6082             event        => $row->{event_raw},
6083             # user data
6084             posterid     => $row->{userid},
6085             poster       => $row->{username}
6086         }
6087     }
6088
6089     if (my $sp = $res->{selfpromo} && $res->{selfpromo}->get_template_params ) {
6090
6091         my $obj = $sp->{object}->[0];
6092
6093         $obj->{ditemid}   = delete $obj->{post_id} if $obj->{post_id};
6094         $obj->{journalid} = delete $obj->{journal_id} if $obj->{journal_id};
6095         LJ::get_aggregated_entry($obj, $entry_opts);
6096
6097         $selfpromo = {
6098             # selfpromo data
6099             remaning_time => $obj->{timeleft},
6100             price         => $obj->{buyout},
6101             # entry data
6102             ditemid       => $obj->{ditemid},
6103             subject       => $obj->{subject_raw},
6104             event         => $obj->{event_raw},
6105             # user data
6106             posterid      => $obj->{journalid},
6107             poster        => $obj->{username},
6108         };
6109     }
6110
6111     return {
6112         status => 'OK',
6113         skip   => $req->{skip} || 0,
6114         region => $req->{region},
6115         events => \@events,
6116         ($req->{getselfpromo} ? (selfpromo => $selfpromo) : ())
6117     };
6118 }
6119
6120 sub getusersrating {
6121     my ($req, $err, $flags) = @_;
6122
6123     $flags->{allow_anonymous} = 1;
6124     return undef unless authenticate($req, $err, $flags) && authorize($req, $err, $flags, 'getusersrating');
6125
6126     my $user_id = $flags->{u} ? $flags->{u}->id : 0;
6127
6128     return fail($err, 200, 'region') unless $req->{region};
6129
6130     return fail($err, 203, 'region') unless $req->{region} =~ /^cyr|noncyr|ua$/;
6131
6132     return fail($err, 203, 'sort') if $req->{sort} &&  $req->{sort} !~ /^hits|friends|authority|default$/;
6133
6134     foreach my $p (qw(skip itemshow user_id)){
6135         return fail($err, 203, 'xmlrpc.des.non_arifmetic', {'param'=>$p, 'value'=>$req->{$p}}) if ($req->{$p} && $req->{$p} =~ /\D/);
6136     }
6137
6138     return fail($err, 209, 'xmlrpc.des.bad_value', {'param'=>'itemshow'}) if $req->{itemshow} > 100;
6139
6140     $req->{getselfpromo} = 1 unless defined $req->{getselfpromo};
6141
6142     my ($res, @err) = LJ::PersonalStats::Ratings::Journals->get_rating_segment( {
6143         rating_country   => $req->{region},
6144         ($req->{sort} ne 'default' ? (sort => $req->{sort}) : ()),
6145         is_community     => $req->{journaltype} eq 'C' ? 1 : 0,
6146         offset           => $req->{skip} || 0,
6147         length           => $req->{itemshow} || 30,
6148         show_selfpromo   => $req->{getselfpromo},
6149         filter_selfpromo => $req->{getselfpromo},
6150     });
6151
6152     return fail($err, 500, $err[0]) unless $res && ref $res && $res->{data} && ref $res->{data};
6153
6154     my (@users, $selfpromo);
6155
6156     my $user_opts = {
6157         attrs => [qw(username display_name profile_url journal_base userpic userhead_url name_raw
6158                      identity_pretty_type identity_value identity_url )],
6159     };
6160
6161     foreach my $row (@{$res->{data}}) {
6162
6163         $row->{userid} = delete $row->{journal_id} if  $row->{journal_id};
6164         LJ::get_aggregated_user($row, $user_opts);
6165
6166         push @users, {
6167             # rating data
6168             rating_value     => $row->{value},
6169             position         => $row->{position},
6170             delta            => $row->{delta},
6171             isnew            => $row->{is_new} || 0,
6172             was_in_promo     => $row->{was_in_promo} || 0,
6173             # user data
6174             username         => $row->{username},
6175             identity_display => $row->{display_name},
6176             identity_url     => $row->{identity_url},
6177             identity_type    => $row->{identity_pretty_type},
6178             identity_value   => $row->{identity_value},
6179             userpic_url      => $row->{userpic} ? $row->{userpic}->url : '',
6180             journal_url      => $row->{journal_base},
6181             userhead_url     => $row->{userhead_url},
6182             title            => $row->{name_raw},
6183         }
6184     }
6185
6186     if (my $sp = $res->{selfpromo} && $res->{selfpromo}->get_template_params ) {
6187
6188         $selfpromo = {
6189             # selfpromo data
6190             remaning_time    => $sp->{timeleft},
6191             price            => $sp->{buyout},
6192         };
6193
6194         $sp = $sp->{object}->[0];
6195
6196         $sp->{userid} = delete $sp->{journal_id} if  $sp->{journal_id};
6197         LJ::get_aggregated_user($sp, $user_opts);
6198
6199         $selfpromo = {
6200             %$selfpromo,
6201             # user data
6202             username         => $sp->{username},
6203             identity_display => $sp->{display_name},
6204             identity_url     => $sp->{identity_url},
6205             identity_type    => $sp->{identity_pretty_type},
6206             identity_value   => $sp->{identity_value},
6207             userpic_url      => $sp->{userpic} ? $sp->{userpic}->url : '',
6208             journal_url      => $sp->{journal_base},
6209             userhead_url     => $sp->{userhead_url},
6210             title            => $sp->{name_raw},
6211         };
6212     }
6213
6214     return {
6215         status => 'OK',
6216         skip   => $req->{skip} || 0,
6217         region => $req->{region},
6218         users => \@users,
6219         ($req->{getselfpromo} ? (selfpromo => $selfpromo) : ())
6220     };
6221 }
6222
6223 #### Old interface (flat key/values) -- wrapper aruond LJ::Protocol
6224 package LJ;
6225
6226 sub do_request {
6227     # get the request and response hash refs
6228     my ($req, $res, $flags) = @_;
6229
6230     # initialize some stuff
6231     %$res  = ();                      # clear the given response hash
6232     $flags = {} unless (ref $flags eq "HASH");
6233
6234     # did they send a mode?
6235     unless ($req->{'mode'}) {
6236         $res->{'success'} = "FAIL";
6237         $res->{'errmsg'} = "Client error: No mode specified.";
6238         return;
6239     }
6240
6241     # this method doesn't require auth
6242     if ($req->{'mode'} eq "getchallenge") {
6243         return getchallenge($req, $res, $flags);
6244     }
6245
6246     # mode from here on out require a username
6247     my $user = LJ::canonical_username($req->{'user'});
6248     unless ($user) {
6249         $res->{'success'} = "FAIL";
6250         $res->{'errmsg'} = "Client error: No username sent.";
6251         return;
6252     }
6253
6254     ### see if the server's under maintenance now
6255     if ($LJ::SERVER_DOWN) {
6256         $res->{'success'} = "FAIL";
6257         $res->{'errmsg'} = $LJ::SERVER_DOWN_MESSAGE;
6258         return;
6259     }
6260
6261     ## dispatch wrappers
6262     if ($req->{'mode'} eq "login") {
6263         return login($req, $res, $flags);
6264     }
6265     if ($req->{'mode'} eq "getfriendgroups") {
6266         return getfriendgroups($req, $res, $flags);
6267     }
6268     if ($req->{'mode'} eq "getfriends") {
6269         return getfriends($req, $res, $flags);
6270     }
6271     if ($req->{'mode'} eq "friendof") {
6272         return friendof($req, $res, $flags);
6273     }
6274     if ($req->{'mode'} eq "checkfriends") {
6275         return checkfriends($req, $res, $flags);
6276     }
6277     if ($req->{'mode'} eq "getdaycounts") {
6278         return getdaycounts($req, $res, $flags);
6279     }
6280     if ($req->{'mode'} eq "postevent") {
6281         return postevent($req, $res, $flags);
6282     }
6283     if ($req->{'mode'} eq "editevent") {
6284         return editevent($req, $res, $flags);
6285     }
6286     if ($req->{'mode'} eq "syncitems") {
6287         return syncitems($req, $res, $flags);
6288     }
6289     if ($req->{'mode'} eq "getevents") {
6290         return getevents($req, $res, $flags);
6291     }
6292     if ($req->{'mode'} eq "editfriends") {
6293         return editfriends($req, $res, $flags);
6294     }
6295     if ($req->{'mode'} eq "editfriendgroups") {
6296         return editfriendgroups($req, $res, $flags);
6297     }
6298     if ($req->{'mode'} eq "consolecommand") {
6299         return consolecommand($req, $res, $flags);
6300     }
6301     if ($req->{'mode'} eq "sessiongenerate") {
6302         return sessiongenerate($req, $res, $flags);
6303     }
6304     if ($req->{'mode'} eq "sessionexpire") {
6305         return sessionexpire($req, $res, $flags);
6306     }
6307     if ($req->{'mode'} eq "getusertags") {
6308         return getusertags($req, $res, $flags);
6309     }
6310     if ($req->{'mode'} eq "getfriendspage") {
6311         return getfriendspage($req, $res, $flags);
6312     }
6313
6314     ### unknown mode!
6315     $res->{'success'} = "FAIL";
6316     $res->{'errmsg'} = "Client error: Unknown mode ($req->{'mode'})";
6317     return;
6318 }
6319
6320 ## flat wrapper
6321 sub getfriendspage
6322 {
6323     my ($req, $res, $flags) = @_;
6324
6325     my $err = 0;
6326     my $rq = upgrade_request($req);
6327
6328     my $rs = LJ::Protocol::do_request("getfriendspage", $rq, \$err, $flags);
6329     unless ($rs) {
6330         $res->{'success'} = "FAIL";
6331         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6332         return 0;
6333     }
6334
6335     my $ect = 0;
6336     foreach my $evt (@{$rs->{'entries'}}) {
6337         $ect++;
6338         foreach my $f (qw(subject_raw journalname journaltype postername postertype ditemid security)) {
6339             if (defined $evt->{$f}) {
6340                 $res->{"entries_${ect}_$f"} = $evt->{$f};
6341             }
6342         }
6343         $res->{"entries_${ect}_event"} = LJ::eurl($evt->{'event_raw'});
6344     }
6345
6346     $res->{'entries_count'} = $ect;
6347     $res->{'success'} = "OK";
6348
6349     return 1;
6350 }
6351
6352 ## flat wrapper
6353 sub login
6354 {
6355     my ($req, $res, $flags) = @_;
6356
6357     my $err = 0;
6358     my $rq = upgrade_request($req);
6359
6360     my $rs = LJ::Protocol::do_request("login", $rq, \$err, $flags);
6361     unless ($rs) {
6362         $res->{'success'} = "FAIL";
6363         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6364         return 0;
6365     }
6366
6367     $res->{'success'} = "OK";
6368     $res->{'name'} = $rs->{'fullname'};
6369     $res->{'message'} = $rs->{'message'} if $rs->{'message'};
6370     $res->{'fastserver'} = 1 if $rs->{'fastserver'};
6371     $res->{'caps'} = $rs->{'caps'} if $rs->{'caps'};
6372
6373     # shared journals
6374     my $access_count = 0;
6375     foreach my $user (@{$rs->{'usejournals'}}) {
6376         $access_count++;
6377         $res->{"access_${access_count}"} = $user;
6378     }
6379     if ($access_count) {
6380         $res->{"access_count"} = $access_count;
6381     }
6382
6383     # friend groups
6384     populate_friend_groups($res, $rs->{'friendgroups'});
6385
6386     my $flatten = sub {
6387         my ($prefix, $listref) = @_;
6388         my $ct = 0;
6389         foreach (@$listref) {
6390             $ct++;
6391             $res->{"${prefix}_$ct"} = $_;
6392         }
6393         $res->{"${prefix}_count"} = $ct;
6394     };
6395
6396     ### picture keywords
6397     $flatten->("pickw", $rs->{'pickws'})
6398         if defined $req->{"getpickws"};
6399     $flatten->("pickwurl", $rs->{'pickwurls'})
6400         if defined $req->{"getpickwurls"};
6401     $res->{'defaultpicurl'} = $rs->{'defaultpicurl'} if $rs->{'defaultpicurl'};
6402
6403     ### report new moods that this client hasn't heard of, if they care
6404     if (defined $req->{"getmoods"}) {
6405         my $mood_count = 0;
6406         foreach my $m (@{$rs->{'moods'}}) {
6407             $mood_count++;
6408             $res->{"mood_${mood_count}_id"} = $m->{'id'};
6409             $res->{"mood_${mood_count}_name"} = $m->{'name'};
6410             $res->{"mood_${mood_count}_parent"} = $m->{'parent'};
6411         }
6412         if ($mood_count) {
6413             $res->{"mood_count"} = $mood_count;
6414         }
6415     }
6416
6417     #### send web menus
6418     if ($req->{"getmenus"} == 1) {
6419         my $menu = $rs->{'menus'};
6420         my $menu_num = 0;
6421         populate_web_menu($res, $menu, \$menu_num);
6422     }
6423
6424     return 1;
6425 }
6426
6427 ## flat wrapper
6428 sub getfriendgroups
6429 {
6430     my ($req, $res, $flags) = @_;
6431
6432     my $err = 0;
6433     my $rq = upgrade_request($req);
6434
6435     my $rs = LJ::Protocol::do_request("getfriendgroups", $rq, \$err, $flags);
6436     unless ($rs) {
6437         $res->{'success'} = "FAIL";
6438         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6439         return 0;
6440     }
6441     $res->{'success'} = "OK";
6442     populate_friend_groups($res, $rs->{'friendgroups'});
6443
6444     return 1;
6445 }
6446
6447 ## flat wrapper
6448 sub getusertags
6449 {
6450     my ($req, $res, $flags) = @_;
6451
6452     my $err = 0;
6453     my $rq = upgrade_request($req);
6454
6455     my $rs = LJ::Protocol::do_request("getusertags", $rq, \$err, $flags);
6456     unless ($rs) {
6457         $res->{'success'} = "FAIL";
6458         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6459         return 0;
6460     }
6461
6462     $res->{'success'} = "OK";
6463
6464     my $ct = 0;
6465     foreach my $tag (@{$rs->{tags}}) {
6466         $ct++;
6467         $res->{"tag_${ct}_security"} = $tag->{security_level};
6468         $res->{"tag_${ct}_uses"} = $tag->{uses} if $tag->{uses};
6469         $res->{"tag_${ct}_display"} = $tag->{display} if $tag->{display};
6470         $res->{"tag_${ct}_name"} = $tag->{name};
6471         foreach my $lev (qw(friends private public)) {
6472             $res->{"tag_${ct}_sb_$_"} = $tag->{security}->{$_}
6473                 if $tag->{security}->{$_};
6474         }
6475         my $gm = 0;
6476         foreach my $grpid (keys %{$tag->{security}->{groups}}) {
6477             next unless $tag->{security}->{groups}->{$grpid};
6478             $gm++;
6479             $res->{"tag_${ct}_sb_group_${gm}_id"} = $grpid;
6480             $res->{"tag_${ct}_sb_group_${gm}_count"} = $tag->{security}->{groups}->{$grpid};
6481         }
6482         $res->{"tag_${ct}_sb_group_count"} = $gm if $gm;
6483     }
6484     $res->{'tag_count'} = $ct;
6485
6486     return 1;
6487 }
6488
6489 ## flat wrapper
6490 sub getfriends
6491 {
6492     my ($req, $res, $flags) = @_;
6493
6494     my $err = 0;
6495     my $rq = upgrade_request($req);
6496
6497     my $rs = LJ::Protocol::do_request("getfriends", $rq, \$err, $flags);
6498     unless ($rs) {
6499         $res->{'success'} = "FAIL";
6500         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6501         return 0;
6502     }
6503
6504     $res->{'success'} = "OK";
6505     if ($req->{'includegroups'}) {
6506         populate_friend_groups($res, $rs->{'friendgroups'});
6507     }
6508     if ($req->{'includefriendof'}) {
6509         populate_friends($res, "friendof", $rs->{'friendofs'});
6510     }
6511     populate_friends($res, "friend", $rs->{'friends'});
6512
6513     return 1;
6514 }
6515
6516 ## flat wrapper
6517 sub friendof
6518 {
6519     my ($req, $res, $flags) = @_;
6520
6521     my $err = 0;
6522     my $rq = upgrade_request($req);
6523
6524     my $rs = LJ::Protocol::do_request("friendof", $rq, \$err, $flags);
6525     unless ($rs) {
6526         $res->{'success'} = "FAIL";
6527         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6528         return 0;
6529     }
6530
6531     $res->{'success'} = "OK";
6532     populate_friends($res, "friendof", $rs->{'friendofs'});
6533     return 1;
6534 }
6535
6536 ## flat wrapper
6537 sub checkfriends
6538 {
6539     my ($req, $res, $flags) = @_;
6540
6541     my $err = 0;
6542     my $rq = upgrade_request($req);
6543
6544     my $rs = LJ::Protocol::do_request("checkfriends", $rq, \$err, $flags);
6545     unless ($rs) {
6546         $res->{'success'} = "FAIL";
6547         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6548         return 0;
6549     }
6550
6551     $res->{'success'} = "OK";
6552     $res->{'new'} = $rs->{'new'};
6553     $res->{'lastupdate'} = $rs->{'lastupdate'};
6554     $res->{'interval'} = $rs->{'interval'};
6555     return 1;
6556 }
6557
6558 ## flat wrapper
6559 sub getdaycounts
6560 {
6561     my ($req, $res, $flags) = @_;
6562
6563     my $err = 0;
6564     my $rq = upgrade_request($req);
6565
6566     my $rs = LJ::Protocol::do_request("getdaycounts", $rq, \$err, $flags);
6567     unless ($rs) {
6568         $res->{'success'} = "FAIL";
6569         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6570         return 0;
6571     }
6572
6573     $res->{'success'} = "OK";
6574     foreach my $d (@{ $rs->{'daycounts'} }) {
6575         $res->{$d->{'date'}} = $d->{'count'};
6576     }
6577     return 1;
6578 }
6579
6580 ## flat wrapper
6581 sub syncitems
6582 {
6583     my ($req, $res, $flags) = @_;
6584
6585     my $err = 0;
6586     my $rq = upgrade_request($req);
6587
6588     my $rs = LJ::Protocol::do_request("syncitems", $rq, \$err, $flags);
6589     unless ($rs) {
6590         $res->{'success'} = "FAIL";
6591         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6592         return 0;
6593     }
6594
6595     $res->{'success'} = "OK";
6596     $res->{'sync_total'} = $rs->{'total'};
6597     $res->{'sync_count'} = $rs->{'count'};
6598
6599     my $ct = 0;
6600     foreach my $s (@{ $rs->{'syncitems'} }) {
6601         $ct++;
6602         foreach my $a (qw(item action time)) {
6603             $res->{"sync_${ct}_$a"} = $s->{$a};
6604         }
6605     }
6606     return 1;
6607 }
6608
6609 ## flat wrapper: limited functionality.  (1 command only, server-parsed only)
6610 sub consolecommand
6611 {
6612     my ($req, $res, $flags) = @_;
6613
6614     my $err = 0;
6615     my $rq = upgrade_request($req);
6616     delete $rq->{'command'};
6617
6618     $rq->{'commands'} = [ $req->{'command'} ];
6619
6620     my $rs = LJ::Protocol::do_request("consolecommand", $rq, \$err, $flags);
6621     unless ($rs) {
6622         $res->{'success'} = "FAIL";
6623         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6624         return 0;
6625     }
6626
6627     $res->{'cmd_success'} = $rs->{'results'}->[0]->{'success'};
6628     $res->{'cmd_line_count'} = 0;
6629     foreach my $l (@{$rs->{'results'}->[0]->{'output'}}) {
6630         $res->{'cmd_line_count'}++;
6631         my $line = $res->{'cmd_line_count'};
6632         $res->{"cmd_line_${line}_type"} = $l->[0]
6633             if $l->[0];
6634         $res->{"cmd_line_${line}"} = $l->[1];
6635     }
6636
6637     $res->{'success'} = "OK";
6638
6639 }
6640
6641 ## flat wrapper
6642 sub getchallenge
6643 {
6644     my ($req, $res, $flags) = @_;
6645     my $err = 0;
6646     my $rs = LJ::Protocol::do_request("getchallenge", $req, \$err, $flags);
6647
6648     # stupid copy (could just return $rs), but it might change in the future
6649     # so this protects us from future accidental harm.
6650     foreach my $k (qw(challenge server_time expire_time auth_scheme)) {
6651         $res->{$k} = $rs->{$k};
6652     }
6653
6654     $res->{'success'} = "OK";
6655     return $res;
6656 }
6657
6658 ## flat wrapper
6659 sub editfriends
6660 {
6661     my ($req, $res, $flags) = @_;
6662
6663     my $err = 0;
6664     my $rq = upgrade_request($req);
6665
6666     $rq->{'add'} = [];
6667     $rq->{'delete'} = [];
6668
6669     foreach (keys %$req) {
6670         if (/^editfriend_add_(\d+)_user$/) {
6671             my $n = $1;
6672             next unless ($req->{"editfriend_add_${n}_user"} =~ /\S/);
6673             my $fa = { 'username' => $req->{"editfriend_add_${n}_user"},
6674                        'fgcolor' => $req->{"editfriend_add_${n}_fg"},
6675                        'bgcolor' => $req->{"editfriend_add_${n}_bg"},
6676                        'groupmask' => $req->{"editfriend_add_${n}_groupmask"},
6677                    };
6678             push @{$rq->{'add'}}, $fa;
6679         } elsif (/^editfriend_delete_(\w+)$/) {
6680             push @{$rq->{'delete'}}, $1;
6681         }
6682     }
6683
6684     my $rs = LJ::Protocol::do_request("editfriends", $rq, \$err, $flags);
6685     unless ($rs) {
6686         $res->{'success'} = "FAIL";
6687         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6688         return 0;
6689     }
6690
6691     $res->{'success'} = "OK";
6692
6693     my $ct = 0;
6694     foreach my $fa (@{ $rs->{'added'} }) {
6695         $ct++;
6696         $res->{"friend_${ct}_user"} = $fa->{'username'};
6697         $res->{"friend_${ct}_name"} = $fa->{'fullname'};
6698     }
6699
6700     $res->{'friends_added'} = $ct;
6701
6702     return 1;
6703 }
6704
6705 ## flat wrapper
6706 sub editfriendgroups
6707 {
6708     my ($req, $res, $flags) = @_;
6709
6710     my $err = 0;
6711     my $rq = upgrade_request($req);
6712
6713     $rq->{'groupmasks'} = {};
6714     $rq->{'set'} = {};
6715     $rq->{'delete'} = [];
6716
6717     foreach (keys %$req) {
6718         if (/^efg_set_(\d+)_name$/) {
6719             next unless ($req->{$_} ne "");
6720             my $n = $1;
6721             my $fs = {
6722                 'name' => $req->{"efg_set_${n}_name"},
6723                 'sort' => $req->{"efg_set_${n}_sort"},
6724             };
6725             if (defined $req->{"efg_set_${n}_public"}) {
6726                 $fs->{'public'} = $req->{"efg_set_${n}_public"};
6727             }
6728             $rq->{'set'}->{$n} = $fs;
6729         }
6730         elsif (/^efg_delete_(\d+)$/) {
6731             if ($req->{$_}) {
6732                 # delete group if value is true
6733                 push @{$rq->{'delete'}}, $1;
6734             }
6735         }
6736         elsif (/^editfriend_groupmask_(\w+)$/) {
6737             $rq->{'groupmasks'}->{$1} = $req->{$_};
6738         }
6739     }
6740
6741     my $rs = LJ::Protocol::do_request("editfriendgroups", $rq, \$err, $flags);
6742     unless ($rs) {
6743         $res->{'success'} = "FAIL";
6744         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6745         return 0;
6746     }
6747
6748     $res->{'success'} = "OK";
6749     return 1;
6750 }
6751
6752 sub flatten_props
6753 {
6754     my ($req, $rq) = @_;
6755
6756     ## changes prop_* to props hashref
6757     foreach my $k (keys %$req) {
6758         next unless ($k =~ /^prop_(.+)/);
6759         $rq->{'props'}->{$1} = $req->{$k};
6760     }
6761 }
6762
6763 ## flat wrapper
6764 sub postevent
6765 {
6766     my ($req, $res, $flags) = @_;
6767
6768     my $err = 0;
6769     my $rq = upgrade_request($req);
6770     flatten_props($req, $rq);
6771     $rq->{'props'}->{'interface'} = "flat";
6772
6773     my $rs = LJ::Protocol::do_request("postevent", $rq, \$err, $flags);
6774     unless ($rs) {
6775         $res->{'success'} = "FAIL";
6776         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6777         return 0;
6778     }
6779
6780     $res->{'message'} = $rs->{'message'} if $rs->{'message'};
6781     $res->{'extra_result_message'} = $rs->{'extra_result_message'} if $rs->{'extra_result_message'};
6782     $res->{'success'} = "OK";
6783     $res->{'itemid'} = $rs->{'itemid'};
6784     $res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
6785     $res->{'url'} = $rs->{'url'} if defined $rs->{'url'};
6786     # we may not translate 'warnings' here, because it may contain \n characters
6787     return 1;
6788 }
6789
6790 ## flat wrapper
6791 sub editevent
6792 {
6793     my ($req, $res, $flags) = @_;
6794
6795     my $err = 0;
6796     my $rq = upgrade_request($req);
6797     flatten_props($req, $rq);
6798
6799     my $rs = LJ::Protocol::do_request("editevent", $rq, \$err, $flags);
6800     unless ($rs) {
6801         $res->{'success'} = "FAIL";
6802         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6803         return 0;
6804     }
6805
6806     $res->{'success'} = "OK";
6807     $res->{'itemid'} = $rs->{'itemid'};
6808     $res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
6809     $res->{'url'} = $rs->{'url'} if defined $rs->{'url'};
6810     return 1;
6811 }
6812
6813 ## flat wrapper
6814 sub sessiongenerate {
6815     my ($req, $res, $flags) = @_;
6816
6817     my $err = 0;
6818     my $rq = upgrade_request($req);
6819
6820     my $rs = LJ::Protocol::do_request('sessiongenerate', $rq, \$err, $flags);
6821     unless ($rs) {
6822         $res->{success} = 'FAIL';
6823         $res->{errmsg} = LJ::Protocol::error_message($err);
6824     }
6825
6826     $res->{success} = 'OK';
6827     $res->{ljsession} = $rs->{ljsession};
6828     return 1;
6829 }
6830
6831 ## flat wrappre
6832 sub sessionexpire {
6833     my ($req, $res, $flags) = @_;
6834
6835     my $err = 0;
6836     my $rq = upgrade_request($req);
6837
6838     $rq->{expire} = [];
6839     foreach my $k (keys %$rq) {
6840         push @{$rq->{expire}}, $1
6841             if $k =~ /^expire_id_(\d+)$/;
6842     }
6843
6844     my $rs = LJ::Protocol::do_request('sessionexpire', $rq, \$err, $flags);
6845     unless ($rs) {
6846         $res->{success} = 'FAIL';
6847         $res->{errmsg} = LJ::Protocol::error_message($err);
6848     }
6849
6850     $res->{success} = 'OK';
6851     return 1;
6852 }
6853
6854 ## flat wrapper
6855 sub getevents {
6856     my ($req, $res, $flags) = @_;
6857
6858     my $err = 0;
6859     my $rq = upgrade_request($req);
6860
6861     my $rs = LJ::Protocol::do_request("getevents", $rq, \$err, $flags);
6862     unless ($rs) {
6863         $res->{'success'} = "FAIL";
6864         $res->{'errmsg'} = LJ::Protocol::error_message($err);
6865         return 0;
6866     }
6867
6868     my $pct = 0;
6869     my $ect = 0;
6870
6871     foreach my $evt (@{$rs->{'events'}}) {
6872         $ect++;
6873         foreach my $f (qw(itemid eventtime security allowmask subject anum url poster)) {
6874             if (defined $evt->{$f}) {
6875                 $res->{"events_${ect}_$f"} = $evt->{$f};
6876             }
6877         }
6878         $res->{"events_${ect}_event"} = LJ::eurl($evt->{'event'});
6879
6880         if ($evt->{'props'}) {
6881             foreach my $k (sort keys %{$evt->{'props'}}) {
6882                 $pct++;
6883                 $res->{"prop_${pct}_itemid"} = $evt->{'itemid'};
6884                 $res->{"prop_${pct}_name"} = $k;
6885                 $res->{"prop_${pct}_value"} = $evt->{'props'}->{$k};
6886             }
6887         }
6888     }
6889
6890     unless ($req->{'noprops'}) {
6891         $res->{'prop_count'} = $pct;
6892     }
6893
6894     $res->{'events_count'} = $ect;
6895     $res->{'success'} = "OK";
6896
6897     return 1;
6898 }
6899
6900
6901 sub populate_friends
6902 {
6903     my ($res, $pfx, $list) = @_;
6904     my $count = 0;
6905     foreach my $f (@$list)
6906     {
6907         $count++;
6908         $res->{"${pfx}_${count}_name"} = $f->{'fullname'};
6909         $res->{"${pfx}_${count}_user"} = $f->{'username'};
6910         $res->{"${pfx}_${count}_birthday"} = $f->{'birthday'} if $f->{'birthday'};
6911         $res->{"${pfx}_${count}_bg"} = $f->{'bgcolor'};
6912         $res->{"${pfx}_${count}_fg"} = $f->{'fgcolor'};
6913         if (defined $f->{'groupmask'}) {
6914             $res->{"${pfx}_${count}_groupmask"} = $f->{'groupmask'};
6915         }
6916         if (defined $f->{'type'}) {
6917             $res->{"${pfx}_${count}_type"} = $f->{'type'};
6918             if ($f->{'type'} eq 'identity') {
6919                 $res->{"${pfx}_${count}_identity_type"}    = $f->{'identity_type'};
6920                 $res->{"${pfx}_${count}_identity_value"}   = $f->{'identity_value'};
6921                 $res->{"${pfx}_${count}_identity_display"} = $f->{'identity_display'};
6922             }
6923         }
6924         if (defined $f->{'status'}) {
6925             $res->{"${pfx}_${count}_status"} = $f->{'status'};
6926         }
6927     }
6928     $res->{"${pfx}_count"} = $count;
6929 }
6930
6931
6932 sub upgrade_request
6933 {
6934     my $r = shift;
6935     my $new = { %{ $r } };
6936     $new->{'username'} = $r->{'user'};
6937
6938     # but don't delete $r->{'user'}, as it might be, say, %FORM,
6939     # that'll get reused in a later request in, say, update.bml after
6940     # the login before postevent.  whoops.
6941
6942     return $new;
6943 }
6944
6945 ## given a $res hashref and friend group subtree (arrayref), flattens it
6946 sub populate_friend_groups
6947 {
6948     my ($res, $fr) = @_;
6949
6950     my $maxnum = 0;
6951     foreach my $fg (@$fr)
6952     {
6953         my $num = $fg->{'id'};
6954         $res->{"frgrp_${num}_name"} = $fg->{'name'};
6955         $res->{"frgrp_${num}_sortorder"} = $fg->{'sortorder'};
6956         if ($fg->{'public'}) {
6957             $res->{"frgrp_${num}_public"} = 1;
6958         }
6959         if ($num > $maxnum) { $maxnum = $num; }
6960     }
6961     $res->{'frgrp_maxnum'} = $maxnum;
6962 }
6963
6964 ## given a menu tree, flattens it into $res hashref
6965 sub populate_web_menu
6966 {
6967     my ($res, $menu, $numref) = @_;
6968     my $mn = $$numref;  # menu number
6969     my $mi = 0;         # menu item
6970     foreach my $it (@$menu) {
6971         $mi++;
6972         $res->{"menu_${mn}_${mi}_text"} = $it->{'text'};
6973         if ($it->{'text'} eq "-") { next; }
6974         if ($it->{'sub'}) {
6975             $$numref++;
6976             $res->{"menu_${mn}_${mi}_sub"} = $$numref;
6977             &populate_web_menu($res, $it->{'sub'}, $numref);
6978             next;
6979
6980         }
6981         $res->{"menu_${mn}_${mi}_url"} = $it->{'url'};
6982     }
6983     $res->{"menu_${mn}_count"} = $mi;
6984 }
6985
6986 1;