root/trunk/cgi-bin/ljprotocol.pl @ 901

Revision 901, 77.6 KB (checked in by bradfitz, 11 years ago)

more recent_ killing I forgot earlier
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1#!/usr/bin/perl
2#
3
4use strict;
5
6require "$ENV{'LJHOME'}/cgi-bin/ljpoll.pl";
7require "$ENV{'LJHOME'}/cgi-bin/ljconfig.pl";
8require "$ENV{'LJHOME'}/cgi-bin/console.pl";
9
10#### New interface (meta handler) ... other handlers should call into this.
11package LJ::Protocol;
12
13sub error_message
14{
15    my $code = shift;
16    my $des;
17    if ($code =~ /^(\d\d\d):(.+)/) {
18        ($code, $des) = ($1, $2);
19    }
20    my %e = (
21             # User Errors
22             "100" => "Invalid username",
23             "101" => "Invalid password",
24             "102" => "Can't use custom security on shared/community journals.",
25             "103" => "Poll error",
26             "104" => "Error adding one or more friends",
27             "150" => "Can't post as non-user",
28             "151" => "Banned from journal",
29             "152" => "Can't make back-dated entries in non-personal journal.",
30
31             # Client Errors
32             "200" => "Missing required argument(s)",
33             "201" => "Unknown method",
34             "202" => "Too many arguments",
35             "203" => "Invalid argument(s)",
36             "204" => "Invalid metadata datatype",
37             "205" => "Unknown metadata",
38             "206" => "Invalid destination journal username.",
39
40             # Access Errors
41             "300" => "Don't have access to shared/community journal",
42             "301" => "Access of restricted feature",
43             "302" => "Can't edit post from requested journal",
44             "303" => "Can't edit post in community journal",
45             "304" => "Can't delete post in this community journal",
46             "305" => "Action forbidden; account is suspended.",
47             "306" => "This journal is temporarily in read-only mode.  Try again in a couple minutes.",
48
49             # Server Errors
50             "500" => "Internal server error",
51             "501" => "Database error",
52             "502" => "Database temporarily unavailable",
53             );
54
55    my $prefix = "";
56    my $error = $e{$code} || "BUG: Unknown error code!";
57    if ($code >= 200) { $prefix = "Client error: "; }
58    if ($code >= 500) { $prefix = "Server error: "; }
59    my $totalerror = "$prefix$error";
60    $totalerror .= ": $des" if $des;
61    return $totalerror;
62}
63
64# returns result, or undef on failure
65sub do_request_without_db
66{
67    my ($method, $req, $err, $flags) = @_;
68    my $dbs = LJ::get_dbs();
69    return fail($err,500) unless $dbs;
70    return do_request($dbs, $method, $req, $err, $flags);
71}
72
73sub do_request
74{
75    # get the request and response hash refs
76    my ($dbs, $method, $req, $err, $flags) = @_;
77
78    $flags ||= {};
79    my @args = ($dbs, $req, $err, $flags);
80
81    if ($method eq "login")            { return login(@args);            }
82    if ($method eq "getfriendgroups")  { return getfriendgroups(@args);  }
83    if ($method eq "getfriends")       { return getfriends(@args);       }
84    if ($method eq "friendof")         { return friendof(@args);         }
85    if ($method eq "checkfriends")     { return checkfriends(@args);     }
86    if ($method eq "getdaycounts")     { return getdaycounts(@args);     }
87    if ($method eq "postevent")        { return postevent(@args);        }
88    if ($method eq "editevent")        { return editevent(@args);        }
89    if ($method eq "syncitems")        { return syncitems(@args);        }
90    if ($method eq "getevents")        { return getevents(@args);        }
91    if ($method eq "editfriends")      { return editfriends(@args);      }
92    if ($method eq "editfriendgroups") { return editfriendgroups(@args); }
93    if ($method eq "consolecommand")   { return consolecommand(@args);   }
94
95    return fail($err,201);
96}
97
98sub login
99{
100    my ($dbs, $req, $err, $flags) = @_;
101    return undef unless authenticate($dbs, $req, $err, $flags);
102
103    my $dbh = $dbs->{'dbh'};
104    return fail($err,502) unless $dbh && $dbs->{'reader'};
105
106    my $u = $flags->{'u'};
107    my $res = {};
108
109    ## return a message to the client to be displayed (optional)
110    login_message($dbs, $req, $res, $flags);
111
112    ## report what shared journals this user may post in
113    $res->{'usejournals'} = list_usejournals($dbs, $u);
114
115    ## return their friend groups
116    $res->{'friendgroups'} = list_friendgroups($dbs, $u);
117
118    ## if they gave us a number of moods to get higher than, then return them
119    if (defined $req->{'getmoods'}) {
120        $res->{'moods'} = list_moods($dbs, $req->{'getmoods'});
121    }
122
123    ### picture keywords, if they asked for them.
124    if ($req->{'getpickws'}) {
125        my $pickws = list_pickws($dbs, $u);
126        $res->{'pickws'} = [ map { $_->[0] } @$pickws ];
127        if ($req->{'getpickwurls'}) {
128            $res->{'pickwurls'} = [ map {
129                "$LJ::SITEROOT/userpic/$_->[1]"
130            } @$pickws ];
131        }
132    }
133
134    ## return client menu tree, if requested
135    if ($req->{'getmenus'}) {
136        $res->{'menus'} = hash_menus($dbs, $u);
137    }
138
139    ## tell some users they can hit the fast servers later.
140    $res->{'fastserver'} = 1 if LJ::get_cap($u, "fastserver");
141
142    ## user info
143    $res->{'userid'} = $u->{'userid'};
144    $res->{'fullname'} = $u->{'name'};
145
146    ## update or add to clientusage table
147    if ($req->{'clientversion'} =~ /^\S+\/\S+$/)  {
148        my $qclient = $dbh->quote($req->{'clientversion'});
149        my $cu_sql = "REPLACE INTO clientusage (userid, clientid, lastlogin) " .
150            "SELECT $u->{'userid'}, clientid, NOW() FROM clients WHERE client=$qclient";
151        my $sth = $dbh->prepare($cu_sql);
152        $sth->execute;
153        unless ($sth->rows) {
154            # only way this can be 0 is if client doesn't exist in clients table, so
155            # we need to add a new row there, to get a new clientid for this new client:
156            $dbh->do("INSERT INTO clients (client) VALUES ($qclient)");
157            # and now we can do the query from before and it should work:
158            $sth = $dbh->prepare($cu_sql);
159            $sth->execute;
160        }
161    }
162
163    return $res;
164}
165
166sub getfriendgroups
167{
168    my ($dbs, $req, $err, $flags) = @_;
169    return undef unless authenticate($dbs, $req, $err, $flags);
170    my $u = $flags->{'u'};
171    my $res = {};
172    $res->{'friendgroups'} = list_friendgroups($dbs, $u);
173    return $res;
174}
175
176sub getfriends
177{
178    my ($dbs, $req, $err, $flags) = @_;
179    return undef unless authenticate($dbs, $req, $err, $flags);
180    return fail($req,502) unless $dbs->{'reader'};
181    my $u = $flags->{'u'};
182    my $res = {};
183    if ($req->{'includegroups'}) {
184        $res->{'friendgroups'} = list_friendgroups($dbs, $u);
185    }
186    if ($req->{'includefriendof'}) {
187        $res->{'friendofs'} = list_friends($dbs, $u, {
188            'limit' => $req->{'friendoflimit'},
189            'friendof' => 1,
190        });
191    }
192    $res->{'friends'} = list_friends($dbs, $u, {
193        'limit' => $req->{'friendlimit'}
194    });
195    return $res;
196}
197
198sub friendof
199{
200    my ($dbs, $req, $err, $flags) = @_;
201    return undef unless authenticate($dbs, $req, $err, $flags);
202    return fail($req,502) unless $dbs->{'reader'};
203    my $u = $flags->{'u'};
204    my $res = {};
205    $res->{'friendofs'} = list_friends($dbs, $u, {
206        'friendof' => 1,
207        'limit' => $req->{'friendoflimit'},
208    });
209    return $res;
210}
211
212sub checkfriends
213{
214    my ($dbs, $req, $err, $flags) = @_;
215    return undef unless authenticate($dbs, $req, $err, $flags);
216    my $u = $flags->{'u'};
217    my $res = {};
218
219    # return immediately if they can't use this mode
220    unless (LJ::get_cap($u, "checkfriends")) {
221        $res->{'new'} = 0;
222        $res->{'interval'} = 36000;  # tell client to bugger off
223        return $res;
224    }
225
226    my $dbr = $dbs->{'reader'};
227    my ($lastdate, $sth);
228
229    ## have a valid date?
230    my $lastupdate = $req->{'lastupdate'};
231    if ($lastupdate) {
232        return fail($err,203) unless
233            ($lastupdate =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
234    } else {
235        $lastupdate = "0000-00-00 00:00:00";
236    }
237
238    my $interval = LJ::get_cap_min($u, "checkfriends_interval");
239    $res->{'interval'} = $interval;
240
241    unless ($dbr) {
242        # rather than return a 502 no-db error, just say no updates,
243        # because problem'll be fixed soon enough by db admins
244        $res->{'new'} = 0;
245        $res->{'lastupdate'} = $lastupdate;
246        return $res;
247    }
248
249    my $sql = "SELECT MAX(u.timeupdate) FROM userusage u, friends f ".
250              "WHERE u.userid=f.friendid AND f.userid=$u->{'userid'}";
251    if ($req->{'mask'} and $req->{'mask'} !~ /\D/) {
252        $sql .= " AND f.groupmask & $req->{mask} > 0";
253    }
254
255    $sth = $dbr->prepare($sql);
256    $sth->execute;
257    my ($update) = $sth->fetchrow_array;
258    $update ||= "0000-00-00 00:00:00";
259
260    if ($req->{'lastupdate'} && $update gt $lastupdate) {
261        $res->{'new'} = 1;
262    } else {
263        $res->{'new'} = 0;
264    }
265
266    $res->{'lastupdate'} = $update;
267
268    return $res;
269}
270
271sub getdaycounts
272{
273    my ($dbs, $req, $err, $flags) = @_;
274    return undef unless authenticate($dbs, $req, $err, $flags);
275    return undef unless check_altusage($dbs, $req, $err, $flags);
276
277    my $u = $flags->{'u'};
278    my $uowner = $flags->{'u_owner'} || $u;
279    my $ownerid = $flags->{'ownerid'};
280
281    my $res = {};
282    my ($db, $table, $ownercol) = ($dbs->{'reader'}, "log", "ownerid");
283    if ($uowner->{'clusterid'}) {
284        $db = LJ::get_cluster_reader($uowner);
285        ($table, $ownercol) = ("log2", "journalid");
286    }
287    return fail($err,502) unless $db;
288
289    my $sth = $db->prepare("SELECT year, month, day, COUNT(*) AS 'count' ".
290                           "FROM $table WHERE $ownercol=$ownerid GROUP BY 1, 2, 3");
291    $sth->execute;
292    while (my ($y, $m, $d, $c) = $sth->fetchrow_array) {
293        my $date = sprintf("%04d-%02d-%02d", $y, $m, $d);
294        push @{$res->{'daycounts'}}, { 'date' => $date, 'count' => $c };
295    }
296    return $res;
297}
298
299sub common_event_validation
300{
301    my ($dbs, $req, $err, $flags) = @_;
302    my $dbr = $dbs->{'reader'};
303
304    # date validation
305    if ($req->{'year'} !~ /^\d\d\d\d$/ ||
306        $req->{'year'} < 1980 ||
307        $req->{'year'} > 2037)
308    {
309        return fail($err,203,"Invalid year value.");
310    }
311    if ($req->{'mon'} !~ /^\d{1,2}$/ ||
312        $req->{'mon'} < 1 ||
313        $req->{'mon'} > 12)
314    {
315        return fail($err,203,"Invalid month value.");
316    }
317    if ($req->{'day'} !~ /^\d{1,2}$/ || $req->{'day'} < 1 ||
318        $req->{'day'} > LJ::days_in_month($req->{'month'},
319                                          $req->{'year'}))
320    {
321        return fail($err,203,"Invalid day of month value.");
322    }
323    if ($req->{'hour'} !~ /^\d{1,2}$/ ||
324        $req->{'hour'} < 0 || $req->{'hour'} > 23)
325    {
326        return fail($err,203,"Invalid hour value.");
327    }
328    if ($req->{'min'} !~ /^\d{1,2}$/ ||
329        $req->{'min'} < 0 || $req->{'min'} > 59)
330    {
331        return fail($err,203,"Invalid minute value.");
332    }
333
334    # setup non-user meta-data.  it's important we define this here to
335    # 0.  if it's not defined at all, then an editevent where a user
336    # removes random 8bit data won't remove the metadata.  not that
337    # that matters much.  but having this here won't hurt.  false
338    # meta-data isn't saved anyway.  so the only point of this next
339    # line is making the metadata be deleted on edit.
340    $req->{'props'}->{'unknown8bit'} = 0;
341
342    # non-ASCII?
343    if ($req->{'event'} =~ /[\x80-\xFF]/ || $req->{'subject'} =~ /[\x80-\xFF]/)
344    {
345        if ($LJ::UNICODE) {
346            # TODO (avva): validate its UTF-8-ness, complain if not
347            #              well-formed, or has overlong characters
348        } else {
349            # so rest of site can change chars to ? marks until
350            # default user's encoding is set.  (legacy support)
351            $req->{'props'}->{'unknown8bit'} = 1;
352        }
353    }
354
355    ## handle meta-data (properties)
356    LJ::load_props($dbs, "log");
357    foreach my $pname (keys %{$req->{'props'}})
358    {
359        my $p = LJ::get_prop("log", $pname);
360
361        # does the property even exist?
362        unless ($p) {
363            $pname =~ s/[^\w]//g;
364            return fail($err,205,$pname);
365        }
366
367        # don't validate its type if it's 0 or undef (deleting)
368        next unless ($req->{'props'}->{$pname});
369
370        my $ptype = $p->{'datatype'};
371        my $val = $req->{'props'}->{$pname};
372
373        if ($ptype eq "bool" && $val !~ /^[01]$/) {
374            return fail($err,204,"Property \"$pname\" should be 0 or 1");
375        }
376        if ($ptype eq "num" && $val =~ /[^\d]/) {
377            return fail($err,204,"Property \"$pname\" should be numeric");
378        }
379    }
380
381    return 1;
382}
383
384sub postevent
385{
386    my ($dbs, $req, $err, $flags) = @_;
387    return undef unless authenticate($dbs, $req, $err, $flags);
388    return undef unless check_altusage($dbs, $req, $err, $flags);
389
390    my $u = $flags->{'u'};
391    my $ownerid = $flags->{'ownerid'};
392    my $uowner = $flags->{'u_owner'} || $u;
393    my $dbr = $dbs->{'reader'};
394    my $dbh = $dbs->{'dbh'};
395
396    return fail($err,306) unless $dbh;
397    return fail($err,200) unless ($req->{'event'} =~ /\S/);
398
399    ### make sure community, shared, or news journals don't post
400    ### note: shared and news journals are deprecated.  every shared journal
401    ##        should one day be a community journal, of some form.
402    return fail($err,150) if ($u->{'journaltype'} eq "C" ||
403                              $u->{'journaltype'} eq "S" ||
404                              $u->{'journaltype'} eq "N");
405
406    # suspended users can't post
407    return fail($err,305) if ($u->{'statusvis'} eq "S");
408
409    # check the journal's read-only bit
410    return fail($err,306) if LJ::get_cap($uowner, "readonly");
411
412    #### clean up the event text
413    my $event = $req->{'event'};
414
415    # remove surrounding whitespace
416    $event =~ s/^\s+//;
417    $event =~ s/\s+$//;
418
419    # convert line endings to unix format
420    if ($req->{'lineendings'} eq "mac") {
421        $event =~ s/\r/\n/g;
422    } else {
423        $event =~ s/\r//g;
424    }
425
426    return undef
427        unless common_event_validation($dbs, $req, $err, $flags);
428
429    ### allow for posting to journals that aren't yours (if you have permission)
430    my $posterid = $u->{'userid'};
431    my $ownerid = $flags->{'ownerid'};
432
433    # make the proper date format
434    my $qeventtime = $dbh->quote(sprintf("%04d-%02d-%02d %02d:%02d",
435                                         $req->{'year'}, $req->{'mon'},
436                                         $req->{'day'}, $req->{'hour'},
437                                         $req->{'min'}));
438    my $qsubject = $dbh->quote($req->{'subject'});
439    my $qallowmask = $req->{'allowmask'}+0;
440    my $qsecurity = "public";
441    my $uselogsec = 0;
442    if ($req->{'security'} eq "usemask" || $req->{'security'} eq "private") {
443        $qsecurity = $req->{'security'};
444    }
445    if ($req->{'security'} eq "usemask") {
446        $uselogsec = 1;
447    }
448    $qsecurity = $dbh->quote($qsecurity);
449
450    ### make sure user can't post with "custom security" on shared journals
451    return fail($err,102)
452        if ($req->{'security'} eq "usemask" &&
453            $qallowmask != 1 && ($ownerid != $posterid));
454
455    ### do processing of embedded polls
456    my @polls = ();
457    if (LJ::Poll::contains_new_poll(\$event))
458    {
459        return fail($err,301,"Your account type doesn't permit creating polls.")
460            unless (LJ::get_cap($u, "makepoll"));
461
462        my $error = "";
463        @polls = LJ::Poll::parse($dbs, \$event, \$error, {
464            'journalid' => $ownerid,
465            'posterid' => $posterid,
466        });
467        return fail($err,103,$error) if $error;
468    }
469
470    # make sure this user isn't banned from posting here (if
471    # this is a community journal)
472    return fail($err,151) if
473        LJ::is_banned($dbs, $posterid, $ownerid);
474
475    # don't allow backdated posts in communities
476    return fail($err,152) if
477        ($req->{'props'}->{"opt_backdated"} &&
478         $uowner->{'journaltype'} ne "P");
479
480    my $qownerid = $ownerid+0;
481    my $qposterid = $posterid+0;
482
483    # by default we record the true reverse time that the item was entered.
484    # however, if backdate is on, we put the reverse time at the end of time
485    # (which makes it equivalent to 1969, but get_recent_items will never load
486    # it... where clause there is: < $LJ::EndOfTime).  but this way we can
487    # have entries that don't show up on friends view, now that we don't have
488    # the hints table to not insert into.
489    my $rlogtime = "$LJ::EndOfTime";
490    unless ($req->{'props'}->{"opt_backdated"}) {
491        $rlogtime .= "-UNIX_TIMESTAMP()";
492    }
493
494    my $dbcm = $dbh;
495    my $clustered = 0;
496    my $anum  = int(rand(256));
497
498    if ($uowner->{'clusterid'}) {
499        $dbcm = LJ::get_cluster_master($uowner);
500        $clustered = 1;
501
502        return fail($err,306) unless $dbcm;
503
504        # before we get going here, we want to make sure to purge this user's
505        # delitem cmd buffer, otherwise we could have a race and that might
506        # wake up later and delete this item which is replacing in the database
507        # the old last item which is marked for deletion:
508        LJ::cmd_buffer_flush($dbh, $dbcm, "delitem", $ownerid);
509
510        $dbcm->do("INSERT INTO log2 (journalid, posterid, eventtime, logtime, security, ".
511                  "allowmask, replycount, year, month, day, revttime, rlogtime, anum) ".
512                  "VALUES ($qownerid, $qposterid, $qeventtime, NOW(), $qsecurity, $qallowmask, ".
513                  "0, $req->{'year'}, $req->{'mon'}, $req->{'day'}, $LJ::EndOfTime-".
514                  "UNIX_TIMESTAMP($qeventtime), $rlogtime, $anum)");
515    } else {
516        $dbcm->do("INSERT INTO log (ownerid, posterid, eventtime, logtime, security, ".
517                  "allowmask, replycount, year, month, day, revttime, rlogtime) ".
518                  "VALUES ($qownerid, $qposterid, $qeventtime, NOW(), $qsecurity, $qallowmask, ".
519                  "0, $req->{'year'}, $req->{'mon'}, $req->{'day'}, $LJ::EndOfTime-".
520                  "UNIX_TIMESTAMP($qeventtime), $rlogtime)");
521    }
522    return fail($err,501,$dbcm->errstr) if $dbcm->err;
523
524    my $itemid = $dbcm->{'mysql_insertid'};
525    return fail($err,501,"No itemid could be generated.") unless $itemid;
526
527    my $ditemid = $clustered ? ($itemid * 256 + $anum) : $itemid;
528
529    ### finish embedding stuff now that we have the itemid
530    {
531        ### this should NOT return an error, and we're mildly fucked by now
532        ### if it does (would have to delete the log row up there), so we're
533        ### not going to check it for now.
534
535        my $error = "";
536        LJ::Poll::register($dbs, \$event, \$error, $ditemid, @polls);
537    }
538    #### /embedding
539
540    ### extract links for meme tracking
541    unless ($req->{'security'} eq "usemask" ||
542            $req->{'security'} eq "private")
543    {
544        foreach my $url (LJ::get_urls($event)) {
545            my $jid = $clustered ? $ownerid : 0;
546            LJ::record_meme($dbs, $url, $posterid, $ditemid, $jid);
547        }
548    }
549
550    # record journal's disk usage (clustered users only)
551    if ($clustered)
552    {
553        my $bytes = length($event) + length($req->{'subject'});
554        LJ::dudata_set($dbcm, $ownerid, 'L', $itemid, $bytes);
555    }
556
557    my $qevent = $dbh->quote($event);
558    $event = "";
559
560    if ($clustered) {
561        $dbcm->do("REPLACE INTO logtext2 (journalid, jitemid, subject, event) ".
562                  "VALUES ($ownerid, $itemid, $qsubject, $qevent)");
563        if ($dbcm->err) {
564            my $msg = $dbcm->errstr;
565            LJ::delete_item2($dbh, $dbcm, $ownerid, $itemid);   # roll-back
566            return fail($err,501,"logtext:$msg");
567        }
568    } else {
569        my @prefix = ("");
570        if ($LJ::USE_RECENT_TABLES) { push @prefix, "recent_"; }
571        foreach my $pfx (@prefix)
572        {
573            $dbh->do("INSERT INTO ${pfx}logtext (itemid, subject, event) ".
574                     "VALUES ($itemid, $qsubject, $qevent)");
575            if ($dbh->err) {
576                my $msg = $dbh->errstr;
577                LJ::delete_item($dbh, $ownerid, $itemid);   # roll-back
578                return fail($err,501,$msg);
579            }
580        }
581    }
582
583    # this is to speed month view and other places that don't need full text.
584    if ($clustered) {
585        $dbcm->do("REPLACE INTO logsubject2 (journalid, jitemid, subject) ".
586                  "VALUES ($ownerid, $itemid, $qsubject)");
587        if ($dbcm->err) {
588            my $msg = $dbcm->errstr;
589            LJ::delete_item2($dbh, $dbcm, $ownerid, $itemid);   # roll-back
590            return fail($err,501,"logsubject:$msg");
591        }
592    } else {
593        $dbh->do("INSERT INTO logsubject (itemid, subject) VALUES ($itemid, $qsubject)");
594        if ($dbh->err) {
595            my $msg = $dbh->errstr;
596            LJ::delete_item($dbh, $ownerid, $itemid);   # roll-back
597            return fail($err,501,$msg);
598        }
599    }
600
601    ## update sync table (selected from log table, so logtime is identical!)
602    if ($clustered) {
603        $dbcm->do("REPLACE INTO syncupdates2 (userid, atime, nodetype, nodeid, atype) ".
604                  "SELECT journalid, logtime, 'L', jitemid, 'create' FROM log2 ".
605                  "WHERE journalid=$ownerid AND jitemid=$itemid");
606        if ($dbcm->err) {
607            my $msg = $dbcm->errstr;
608            LJ::delete_item2($dbh, $dbcm, $ownerid, $itemid);   # roll-back
609            return fail($err,501,$msg);
610        }
611    } else {
612        $dbh->do("REPLACE INTO syncupdates (userid, atime, nodetype, nodeid, atype) ".
613                 "SELECT ownerid, logtime, 'L', itemid, 'create' FROM log WHERE itemid=$itemid");
614        if ($dbh->err) {
615            my $msg = $dbh->errstr;
616            LJ::delete_item($dbh, $ownerid, $itemid);   # roll-back
617            return fail($err,501,$msg);
618        }
619    }
620
621    # keep track of custom security stuff in other table.
622    if ($uselogsec) {
623        if ($clustered) {
624            $dbcm->do("REPLACE INTO logsec2 (journalid, jitemid, allowmask) ".
625                      "VALUES ($qownerid, $itemid, $qallowmask)");
626            if ($dbcm->err) {
627                my $msg = $dbcm->errstr;
628                LJ::delete_item2($dbh, $dbcm, $ownerid, $itemid);   # roll-back
629                return fail($err,501,"logsec2:$msg");
630            }
631        } else {
632            $dbh->do("INSERT INTO logsec (ownerid, itemid, allowmask) ".
633                     "VALUES ($qownerid, $itemid, $qallowmask)");
634            if ($dbh->err) {
635                my $msg = $dbh->errstr;
636                LJ::delete_item($dbh, $ownerid, $itemid);   # roll-back
637                return fail($err,501,$msg);
638            }
639        }
640    }
641
642    # meta-data
643    if (%{$req->{'props'}}) {
644        my $propinsert = "";
645        foreach my $pname (keys %{$req->{'props'}}) {
646            next unless $req->{'props'}->{$pname};
647            if ($propinsert) {
648                $propinsert .= ", ";
649            } else {
650                if ($clustered) {
651                    $propinsert = "REPLACE INTO logprop2 (journalid, jitemid, propid, value) VALUES ";
652                } else {
653                    $propinsert = "INSERT INTO logprop (itemid, propid, value) VALUES ";
654                }
655            }
656            my $p = LJ::get_prop("log", $pname);
657            if ($p) {
658                my $qvalue = $dbh->quote($req->{'props'}->{$pname});
659                if ($clustered) {
660                    $propinsert .= "($ownerid, $itemid, $p->{'id'}, $qvalue)";
661                } else {
662                    $propinsert .= "($itemid, $p->{'id'}, $qvalue)";
663                }
664            }
665        }
666        if ($propinsert) {
667            $dbcm->do($propinsert);   # note: $dbcm may be $dbh
668            if ($dbcm->err) {
669                my $msg = $dbh->errstr;
670                if ($clustered) {
671                    LJ::delete_item2($dbh, $dbcm, $ownerid, $itemid);   # roll-back
672                } else {
673                    LJ::delete_item($dbh, $ownerid, $itemid);   # roll-back
674                }
675                return fail($err,501,"logprop2:$msg");
676            }
677        }
678    }
679
680    $dbh->do("UPDATE userusage SET timeupdate=NOW(), lastitemid=$itemid ".
681             "WHERE userid=$qownerid");
682
683    if ($u->{'track'} eq "yes") {
684        # dear community, relax.  if we get a court order to provide data on somebody,
685        # we're legally required to.  this doesn't enable us to do that.  it enables
686        # us to do it without killing the database and/or servers as we do O(n) scans
687        # over everything and grep the hell out of hundreds of gigs of webserver logs.
688        my $quserid = $u->{'userid'}+0;
689        my $qip = $dbh->quote($ENV{'REMOTE_ADDR'});
690        $dbh->do("INSERT INTO tracking (userid, acttime, ip, actdes, associd) ".
691                 "VALUES ($quserid, NOW(), $qip, 'post', $itemid)");
692    }
693
694    my $res = {};
695    $res->{'itemid'} = $itemid;  # by request of mart
696    $res->{'anum'} = $anum if $clustered;
697    return $res;
698}
699
700sub editevent
701{
702    my ($dbs, $req, $err, $flags) = @_;
703    return undef unless authenticate($dbs, $req, $err, $flags);
704    return undef unless check_altusage($dbs, $req, $err, $flags);
705
706    my $u = $flags->{'u'};
707    my $ownerid = $flags->{'ownerid'};
708    my $uowner = $flags->{'u_owner'} || $u;
709    my $posterid = $u->{'userid'};
710    my $dbr = $dbs->{'reader'};
711    my $dbh = $dbs->{'dbh'};
712    my $sth;
713
714    my $qitemid = $req->{'itemid'}+0;
715
716    # check the journal's read-only bit
717    return fail($err,306) if LJ::get_cap($uowner, "readonly");
718
719    my ($dbcm, $dbcr, $clustered) = ($dbh, $dbr, 0);
720    if ($uowner->{'clusterid'}) {
721        $dbcm = LJ::get_cluster_master($uowner);
722        $clustered = 1;
723    }
724    return fail($err,306) unless $dbcm;
725
726    # fetch the old entry from master database so we know what we
727    # really have to update later.  usually people just edit one part,
728    # not every field in every table.  reads are quicker than writes,
729    # so this is worth it.
730    my $oldevent;
731    if ($clustered)
732    {
733        $oldevent = $dbcm->selectrow_hashref
734            ("SELECT l.journalid AS 'ownerid', l.posterid, l.eventtime, l.logtime, ".
735             "l.compressed, l.security, l.allowmask, l.year, l.month, l.day, lt.subject, ".
736             "MD5(lt.event) AS 'md5event', l.rlogtime, l.anum FROM log2 l, logtext2 lt ".
737             "WHERE l.journalid=$ownerid AND lt.journalid=$ownerid ".
738             "AND l.jitemid=$qitemid AND lt.jitemid=$qitemid");
739    } else {
740        $oldevent = $dbcm->selectrow_hashref
741            ("SELECT l.ownerid, l.posterid, l.eventtime, l.logtime, ".
742             "l.compressed, l.security, l.allowmask, l.year, l.month, l.day, lt.subject, ".
743             "MD5(lt.event) AS 'md5event', l.rlogtime FROM log l, logtext lt ".
744             "WHERE l.itemid=$qitemid AND lt.itemid=$qitemid");
745    }
746
747    ### make sure this user is allowed to edit this entry
748    return fail($err,302)
749        unless ($ownerid == $oldevent->{'ownerid'});
750
751    ### what can they do to somebody elses entry?  (in shared journal)
752    if ($posterid != $oldevent->{'posterid'})
753    {
754        ## deleting.
755        return fail($err,304)
756            if ($req->{'event'} !~ /\S/ && !
757                ($ownerid == $u->{'userid'} ||
758                 # community account can delete it (ick)
759
760                 LJ::check_priv($dbr, $u,
761                                "sharedjournal", $req->{'usejournal'})
762                 # if user is a community maintainer they can delete
763                 # it too (good)
764                 ));
765
766        ## editing:
767        return fail($err,303)
768            if ($req->{'event'} =~ /\S/);
769    }
770
771    ## update sync table (before we actually do it!  in case updates
772    ## partially fail below)
773    if ($clustered) {
774        my $synctype = "update";
775        if ($req->{'event'} !~ /\S/) { $synctype = "del"; }
776        $dbcm->do("REPLACE INTO syncupdates2 (userid, atime, nodetype, nodeid, atype) ".
777                  "VALUES ($ownerid, NOW(), 'L', $qitemid, '$synctype')");
778    } else {
779        $dbh->do("REPLACE INTO syncupdates (userid, atime, nodetype, nodeid, atype) ".
780                 "VALUES ($ownerid, NOW(), 'L', $qitemid, 'update')");
781    }
782
783    # simple logic for deleting an entry
784    if ($req->{'event'} !~ /\S/)
785    {
786        if ($clustered) {
787            LJ::delete_item2($dbh, $dbcm, $ownerid, $req->{'itemid'},
788                             'quick', $oldevent->{'anum'});
789        } else {
790            LJ::delete_item($dbh, $ownerid, $req->{'itemid'});
791        }
792        my $res = { 'itemid' => $qitemid,
793                    'anum' => $oldevent->{'anum'} };
794        return $res;
795    }
796
797    # don't allow backdated posts in communities
798    return fail($err,152) if
799        ($req->{'props'}->{"opt_backdated"} &&
800         $uowner->{'journaltype'} ne "P");
801
802    # updating an entry:
803    return undef
804        unless common_event_validation($dbs, $req, $err, $flags);
805
806    ### load existing meta-data
807    my %curprops;
808
809    if ($clustered) {
810        LJ::load_props($dbs, "log");
811        LJ::load_log_props2($dbcm, $ownerid, [ $qitemid ], \%curprops);
812    } else {
813        LJ::load_log_props($dbh, [ $qitemid ], \%curprops);
814    }
815
816    ## handle meta-data (properties)
817    my %props_byname = ();
818    foreach my $key (keys %{$req->{'props'}}) {
819        ## changing to something else?
820        if ($curprops{$qitemid}->{$key} ne $req->{'props'}->{$key}) {
821            $props_byname{$key} = $req->{'props'}->{$key};
822        }
823    }
824
825    #### clean up the event text
826    my $event = $req->{'event'};
827
828    # remove surrounding whitespace
829    $event =~ s/^\s+//;
830    $event =~ s/\s+$//;
831
832    # convert line endings to unix format
833    if ($req->{'lineendings'} eq "mac") {
834        $event =~ s/\r/\n/g;
835    } else {
836        $event =~ s/\r//g;
837    }
838    my $qevent = $dbh->quote($event);
839    my $bytes = length($event) + length($req->{'subject'});
840    $event = "";
841
842    my $eventtime = sprintf("%04d-%02d-%02d %02d:%02d",
843                            map { $req->{$_} } qw(year mon day hour min));
844    my $qeventtime = $dbh->quote($eventtime);
845
846    my $qallowmask = $req->{'allowmask'}+0;
847    my $security = "public";
848    if ($req->{'security'} eq "private" || $req->{'security'} eq "usemask") {
849        $security = $req->{'security'};
850    }
851
852    my $qyear = $req->{'year'}+0;
853    my $qmonth = $req->{'mon'}+0;
854    my $qday = $req->{'day'}+0;
855
856    if ($qyear != $oldevent->{'year'} ||
857        $qmonth != $oldevent->{'month'} ||
858        $qday != $oldevent->{'day'} ||
859        $eventtime ne $oldevent->{'eventtime'} ||
860        $security ne $oldevent->{'security'} ||
861        $qallowmask != $oldevent->{'allowmask'}
862        )
863    {
864        my $qsecurity = $dbh->quote($security);
865        if ($clustered) {
866            $dbcm->do("UPDATE log2 SET eventtime=$qeventtime, revttime=$LJ::EndOfTime-".
867                      "UNIX_TIMESTAMP($qeventtime), year=$qyear, month=$qmonth, day=$qday, ".
868                      "security=$qsecurity, allowmask=$qallowmask WHERE journalid=$ownerid ".
869                      "AND jitemid=$qitemid");
870        } else {
871            $dbh->do("UPDATE log SET eventtime=$qeventtime, revttime=$LJ::EndOfTime-".
872                     "UNIX_TIMESTAMP($qeventtime), year=$qyear, month=$qmonth, day=$qday, ".
873                     "security=$qsecurity, allowmask=$qallowmask WHERE itemid=$qitemid");
874        }
875    }
876
877    if ($security ne $oldevent->{'security'} ||
878        $qallowmask != $oldevent->{'allowmask'})
879    {
880        if ($security eq "public" || $security eq "private") {
881            if ($clustered) {
882                $dbcm->do("DELETE FROM logsec2 WHERE journalid=$ownerid AND jitemid=$qitemid");
883            } else {
884                $dbh->do("DELETE FROM logsec WHERE ownerid=$ownerid AND itemid=$qitemid");
885            }
886        } else {
887            my $qsecurity = $dbh->quote($security);
888            if ($clustered) {
889                $dbcm->do("REPLACE INTO logsec2 (journalid, jitemid, allowmask) ".
890                          "VALUES ($ownerid, $qitemid, $qallowmask)");
891            } else {
892                $dbh->do("REPLACE INTO logsec (ownerid, itemid, allowmask) ".
893                         "VALUES ($ownerid, $qitemid, $qallowmask)");
894            }
895        }
896        return fail($err,501,$dbcm->errstr) if $dbcm->err;
897    }
898
899    if (Digest::MD5::md5_hex($event) ne $oldevent->{'md5event'} ||
900        $req->{'subject'} ne $oldevent->{'subject'})
901    {
902        my $qsubject = $dbh->quote($req->{'subject'});
903
904        if ($clustered) {
905            $dbcm->do("UPDATE logtext2 SET event=$qevent, subject=$qsubject ".
906                      "WHERE journalid=$ownerid AND jitemid=$qitemid");
907        } else {
908            my @prefix = ("");
909            if ($LJ::USE_RECENT_TABLES) { push @prefix, "recent_"; }
910            foreach my $pfx (@prefix) {
911                $dbh->do("UPDATE ${pfx}logtext SET event=$qevent, subject=$qsubject ".
912                         "WHERE itemid=$qitemid");
913            }
914            return fail($err,501,$dbcm->errstr) if $dbcm->err;
915        }
916        if ($clustered) {
917            $dbcm->do("REPLACE INTO logsubject2 (journalid, jitemid, subject) ".
918                      "VALUES ($ownerid, $qitemid, $qsubject)");
919        } else {
920            $dbh->do("REPLACE INTO logsubject (itemid, subject) ".
921                     "VALUES ($qitemid, $qsubject)");
922        }
923
924        # update disk usage
925        if ($clustered) {
926            LJ::dudata_set($dbcm, $ownerid, 'L', $qitemid, $bytes);
927        }
928
929        return fail($err,501,$dbcm->errstr) if $dbcm->err;
930    }
931
932    if (%{$req->{'props'}}) {
933        my $propinsert = "";
934        my @props_to_delete;
935        foreach my $pname (keys %{$req->{'props'}}) {
936            my $p = LJ::get_prop("log", $pname);
937            next unless $p;
938            my $val = $req->{'props'}->{$pname};
939            unless ($val) {
940                push @props_to_delete, $p->{'id'};
941                next;
942            }
943            if ($propinsert) {
944                $propinsert .= ", ";
945            } else {
946                if ($clustered) {
947                    $propinsert = "REPLACE INTO logprop2 (journalid, jitemid, propid, value) VALUES ";
948                } else {
949                    $propinsert = "REPLACE INTO logprop (itemid, propid, value) VALUES ";
950                }
951            }
952            my $qvalue = $dbh->quote($val);
953            if ($clustered) {
954                $propinsert .= "($ownerid, $qitemid, $p->{'id'}, $qvalue)";
955            } else {
956                $propinsert .= "($qitemid, $p->{'id'}, $qvalue)";
957            }
958        }
959        if ($propinsert) { $dbcm->do($propinsert); }
960        if (@props_to_delete) {
961            my $propid_in = join(", ", @props_to_delete);
962            if ($clustered) {
963                $dbcm->do("DELETE FROM logprop2 WHERE journalid=$ownerid AND ".
964                          "jitemid=$qitemid AND propid IN ($propid_in)");
965            } else {
966                $dbh->do("DELETE FROM logprop WHERE itemid=$qitemid AND propid IN ($propid_in)");
967            }
968        }
969    }
970
971    # deal with backdated changes.  if the entry's rlogtime is
972    # $EndOfTime, then it's backdated.  if they want that off, need to
973    # reset rlogtime to real reverse log time.  also need to set
974    # rlogtime to $EndOfTime if they're turning backdate on.
975    if ($req->{'props'}->{'opt_backdated'} eq "1" &&
976        $oldevent->{'rlogtime'} != $LJ::EndOfTime) {
977        if ($clustered) {
978            $dbh->do("UPDATE log SET rlogtime=$LJ::EndOfTime WHERE ".
979                     "itemid=$qitemid");
980        } else {
981            $dbcm->do("UPDATE log2 SET rlogtime=$LJ::EndOfTime WHERE ".
982                      "journalid=$ownerid AND jitemid=$qitemid");
983        }
984    }
985    if ($req->{'props'}->{'opt_backdated'} eq "0" &&
986        $oldevent->{'rlogtime'} == $LJ::EndOfTime) {
987        if ($clustered) {
988            $dbcm->do("UPDATE log2 SET rlogtime=$LJ::EndOfTime-UNIX_TIMESTAMP(logtime) ".
989                      "WHERE journalid=$ownerid AND jitemid=$qitemid");
990        } else {
991            $dbh->do("UPDATE log SET rlogtime=$LJ::EndOfTime-UNIX_TIMESTAMP(logtime) ".
992                     "WHERE itemid=$qitemid");
993        }
994    }
995
996    return fail($err,501,$dbcm->errstr) if $dbcm->err;
997
998    my $res = { 'itemid' => $qitemid };
999    $res->{'anum'} = $oldevent->{'anum'} if defined $oldevent->{'anum'};
1000    return $res;
1001}
1002
1003sub getevents
1004{
1005    my ($dbs, $req, $err, $flags) = @_;
1006    return undef unless authenticate($dbs, $req, $err, $flags);
1007    return undef unless check_altusage($dbs, $req, $err, $flags);
1008
1009    my $u = $flags->{'u'};
1010    my $uowner = $flags->{'u_owner'} || $u;
1011
1012    ### shared-journal support
1013    my $posterid = $u->{'userid'};
1014    my $ownerid = $flags->{'ownerid'};
1015
1016    my $dbr = $dbs->{'reader'};
1017    my $dbh = $dbs->{'dbh'};
1018    my $sth;
1019
1020    my ($dbcr, $clustered) = ($dbr, 0);
1021    if ($uowner->{'clusterid'}) {
1022        $dbcr = LJ::get_cluster_reader($uowner);
1023        $clustered = 1;
1024    }
1025    return fail($err,502) unless $dbcr;
1026
1027    # if this is on, we sort things different (logtime vs. posttime)
1028    # to avoid timezone issues
1029    my $is_community = ($uowner->{'journaltype'} eq "C" ||
1030                        $uowner->{'journaltype'} eq "S");
1031
1032    # in some cases we'll use the master, to ensure there's no
1033    # replication delay.  useful cases: getting one item, use master
1034    # since user might have just made a typo and realizes it as they
1035    # post, or wants to append something they forgot, etc, etc.  in
1036    # other cases, slave is pretty sure to have it.
1037    my $use_master = 0;
1038
1039    # the benefit of this mode over actually doing 'lastn/1' is
1040    # the $use_master usage.
1041    if ($req->{'selecttype'} eq "one" && $req->{'itemid'} eq "-1") {
1042        $req->{'selecttype'} = "lastn";
1043        $req->{'howmany'} = 1;
1044        undef $req->{'itemid'};
1045        $use_master = 1;  # see note above.
1046    }
1047
1048    # build the query to get log rows.  each selecttype branch is
1049    # responsible for either populating the following 3 variables
1050    # OR just populating $sql
1051    my ($orderby, $where, $limit);
1052    my $sql;
1053    if ($req->{'selecttype'} eq "day")
1054    {
1055        return fail($err,203)
1056            unless ($req->{'year'} =~ /^\d\d\d\d$/ &&
1057                    $req->{'month'} =~ /^\d\d?$/ &&
1058                    $req->{'day'} =~ /^\d\d?$/ &&
1059                    $req->{'month'} >= 1 && $req->{'month'} <= 12 &&
1060                    $req->{'day'} >= 1 && $req->{'day'} <= 31);
1061
1062        my $qyear = $dbh->quote($req->{'year'});
1063        my $qmonth = $dbh->quote($req->{'month'});
1064        my $qday = $dbh->quote($req->{'day'});
1065        $where = "AND year=$qyear AND month=$qmonth AND day=$qday";
1066        $limit = "LIMIT 200";  # FIXME: unhardcode this constant (also in ljviews.pl)
1067
1068        # see note above about why the sort order is different
1069        $orderby = $is_community ? "ORDER BY logtime" : "ORDER BY eventtime";
1070    }
1071    elsif ($req->{'selecttype'} eq "lastn")
1072    {
1073        my $howmany = $req->{'howmany'} || 20;
1074        if ($howmany > 50) { $howmany = 50; }
1075        $howmany = $howmany + 0;
1076        $limit = "LIMIT $howmany";
1077
1078        # okay, follow me here... see how we add the revttime predicate
1079        # even if no beforedate key is present?  you're probably saying,
1080        # that's retarded -- you're saying: "revttime > 0", that's like
1081        # saying, "if entry occured at all."  yes yes, but that hints
1082        # mysql's braindead optimizer to use the right index.
1083        my $rtime_after = 0;
1084        my $rtime_what = $is_community ? "rlogtime" : "revttime";
1085        if ($req->{'beforedate'}) {
1086            return fail($err,203,"Invalid beforedate format.")
1087                unless ($req->{'beforedate'} =~
1088                        /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d$/);
1089            my $qd = $dbh->quote($req->{'beforedate'});
1090            $rtime_after = "$LJ::EndOfTime-UNIX_TIMESTAMP($qd)";
1091        }
1092        $where .= "AND $rtime_what > $rtime_after ";
1093        $orderby = "ORDER BY $rtime_what";
1094    }
1095    elsif ($req->{'selecttype'} eq "one")
1096    {
1097        my $id = $req->{'itemid'} + 0;
1098        $where = $clustered ? "AND jitemid=$id" : "AND itemid=$id";
1099    }
1100    elsif ($req->{'selecttype'} eq "syncitems")
1101    {
1102        my ($date);
1103        ## have a valid date?
1104        $date = $req->{'lastsync'} || "0000-00-00 00:00:00";
1105        if ($date !~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/) {
1106            return fail($err,203,"Invalid syncitems date format.");
1107        }
1108
1109        my $LIMIT = 300;
1110        if ($clustered) {
1111            $sql = "SELECT jitemid, eventtime, security, allowmask, anum ".
1112                "FROM log2 l, syncupdates2 s ".
1113                "WHERE s.userid=$ownerid AND l.journalid=$ownerid ".
1114                "AND s.atime>='$date' AND s.nodetype='L' AND s.nodeid=l.jitemid ".
1115                "AND s.nodeid=l.jitemid ORDER BY s.atime LIMIT $LIMIT";
1116        } else {
1117            $use_master = 1;
1118            $sql = "SELECT itemid, eventtime, security, allowmask ".
1119                "FROM log l, syncupdates s WHERE s.userid=$ownerid ".
1120                "AND s.atime>='$date' AND s.nodetype='L' AND s.nodeid=l.itemid ".
1121                "AND s.nodeid=l.itemid ORDER BY s.atime LIMIT $LIMIT";
1122        }
1123    }
1124    else
1125    {
1126        return fail($err,200,"Invalid selecttype.");
1127    }
1128
1129    # common SQL template:
1130    unless ($sql) {
1131        if ($clustered) {
1132            $sql = "SELECT jitemid, eventtime, security, allowmask, anum ".
1133                   "FROM log2 WHERE journalid=$ownerid $where $orderby $limit";
1134        } else {
1135            $sql = "SELECT itemid, eventtime, security, allowmask ".
1136                      "FROM log WHERE ownerid=$ownerid $where $orderby $limit";
1137        }
1138    }
1139
1140    # whatever selecttype might have wanted us to use the master db.
1141    $dbcr = $clustered ? LJ::get_cluster_master($uowner) : $dbh
1142        if $use_master;
1143
1144    return fail($err,502) unless $dbcr;
1145
1146    ## load the log rows
1147    ($sth = $dbcr->prepare($sql))->execute;
1148    return fail($err,501,$dbcr->errstr) if $dbcr->err;
1149
1150    my $count = 0;
1151    my @itemids = ();
1152    my $res = {};
1153    my $events = $res->{'events'} = [];
1154    my %evt_from_itemid;
1155
1156    while (my ($itemid, $eventtime, $sec, $mask, $anum) = $sth->fetchrow_array)
1157    {
1158        $count++;
1159        my $evt = {};
1160        $evt->{'itemid'} = $itemid;
1161        push @itemids, $itemid;
1162
1163        $evt_from_itemid{$itemid} = $evt;
1164
1165        $evt->{"eventtime"} = $eventtime;
1166        if ($sec ne "public") {
1167            $evt->{'security'} = $sec;
1168            $evt->{'allowmask'} = $mask if $sec eq "usemask";
1169        }
1170        $evt->{'anum'} = $anum if $clustered;
1171        push @$events, $evt;
1172    }
1173
1174    ## load the text
1175    my $text;
1176    my $gt_opts = {
1177        'prefersubjects' => $req->{'prefersubject'} ,
1178        'usemaster' => $use_master,
1179    };
1180    if ($clustered) {
1181        $text = LJ::get_logtext2($uowner, $gt_opts, @itemids);
1182    } else {
1183        $text = LJ::get_logtext($dbs, $gt_opts, @itemids);
1184    }
1185    foreach my $i (@itemids)
1186    {
1187        my $t = $text->{$i};
1188        my $evt = $evt_from_itemid{$i};
1189        if ($t->[0]) {
1190            $t->[0] =~ s/[\r\n]/ /g;
1191            $evt->{'subject'} = $t->[0];
1192        }
1193
1194        # truncate
1195        $t->[1] = substr($t->[1], 0, $req->{'truncate'}-3) . "..."
1196            if ($req->{'truncate'} >= 4 && length($t->[1]) > $req->{'truncate'});
1197
1198        # line endings
1199        $t->[1] =~ s/\r//g;
1200        if ($req->{'lineendings'} eq "unix") {
1201            # do nothing.  native format.
1202        } elsif ($req->{'lineendings'} eq "mac") {
1203            $t->[1] =~ s/\n/\r/g;
1204        } elsif ($req->{'lineendings'} eq "space") {
1205            $t->[1] =~ s/\n/ /g;
1206        } elsif ($req->{'lineendings'} eq "dots") {
1207            $t->[1] =~ s/\n/ ... /g;
1208        } else { # "pc" -- default
1209            $t->[1] =~ s/\n/\r\n/g;
1210        }
1211        $evt->{'event'} = $t->[1];
1212    }
1213
1214    unless ($req->{'noprops'})
1215    {
1216        ### do the properties now
1217        $count = 0;
1218        my %props = ();
1219        if ($clustered) {
1220            LJ::load_props($dbs, "log");
1221            LJ::load_log_props2($dbcr, $ownerid, \@itemids, \%props);
1222        } else {
1223            LJ::load_log_props($dbcr, \@itemids, \%props);
1224        }
1225        foreach my $itemid (keys %props) {
1226            my $evt = $evt_from_itemid{$itemid};
1227            $evt->{'props'} = {};
1228            foreach my $name (keys %{$props{$itemid}}) {
1229                my $value = $props{$itemid}->{$name};
1230                $value =~ s/\n/ /g;
1231                $evt->{'props'}->{$name} = $value;
1232            }
1233        }
1234    }
1235
1236    return $res;
1237}
1238
1239sub editfriends
1240{
1241    my ($dbs, $req, $err, $flags) = @_;
1242    return undef unless authenticate($dbs, $req, $err, $flags);
1243
1244    my $u = $flags->{'u'};
1245    my $userid = $u->{'userid'};
1246    my $dbr = $dbs->{'reader'};
1247    my $dbh = $dbs->{'dbh'};
1248    my $sth;
1249
1250    return fail($err,306) unless $dbh;
1251
1252    my $res = {};
1253
1254    ## first, figure out who the current friends are to save us work later
1255    my %curfriend;
1256    my $friend_count = 0;
1257    $sth = $dbh->prepare("SELECT u.user FROM user u, friends f ".
1258                         "WHERE u.userid=f.friendid AND f.userid=$userid ".
1259                         "AND u.statusvis='V'");
1260    $sth->execute;
1261    while (my ($friend) = $sth->fetchrow_array) {
1262        $curfriend{$friend} = 1;
1263        $friend_count++;
1264    }
1265    $sth->finish;
1266
1267    # perform the deletions
1268  DELETEFRIEND:
1269    foreach (@{$req->{'delete'}})
1270    {
1271        my $deluser = LJ::canonical_username($_);
1272        next DELETEFRIEND unless ($curfriend{$deluser});
1273
1274        my $friendid = LJ::get_userid($dbh, $deluser);
1275        $sth = $dbh->prepare("DELETE FROM friends ".
1276                             "WHERE userid=$userid AND friendid=$friendid");
1277        $sth->execute;
1278        $friend_count--;
1279    }
1280
1281    my $error_flag = 0;
1282    my $friends_added = 0;
1283
1284    # perform the adds
1285  ADDFRIEND:
1286    foreach my $fa (@{$req->{'add'}})
1287    {
1288        unless (ref $fa eq "HASH") {
1289            $fa = { 'username' => $fa };
1290        }
1291
1292        my $aname = LJ::canonical_username($fa->{'username'});
1293        unless ($aname) {
1294            $error_flag = 1;
1295            next ADDFRIEND;
1296        }
1297
1298        $friend_count++ unless $curfriend{$aname};
1299
1300        my $maxfriends = LJ::get_cap($u, "maxfriends");
1301        return fail($err,104,"Exceeded $maxfriends friends limit (now: $friend_count)")
1302            if ($friend_count > $maxfriends);
1303
1304        my $fg = $fa->{'fgcolor'} || "#000000";
1305        my $bg = $fa->{'bgcolor'} || "#FFFFFF";
1306        if ($fg !~ /^\#[0-9A-F]{6,6}$/i || $bg !~ /^\#[0-9A-F]{6,6}$/i) {
1307            return fail($err,203,"Invalid color values");
1308        }
1309
1310        my $row = LJ::load_user($dbs, $aname);
1311        unless ($row && $row->{'statusvis'} eq "V") {
1312            $error_flag = 1;
1313        } else {
1314            $friends_added++;
1315            my $added = { 'username' => $aname,
1316                          'fullname' => $row->{'name'},
1317                      };
1318            push @{$res->{'added'}}, $added;
1319
1320            my $qfg = LJ::color_todb($fg);
1321            my $qbg = LJ::color_todb($bg);
1322
1323            my $friendid = $row->{'userid'};
1324
1325            my $gmask = $fa->{'groupmask'};
1326            if (! $gmask && $curfriend{$aname}) {
1327                # if no group mask sent, use the existing one if this is an existing friend
1328                my $sth = $dbh->prepare("SELECT groupmask FROM friends ".
1329                                        "WHERE userid=$userid AND friendid=$friendid");
1330                $sth->execute;
1331                $gmask = $sth->fetchrow_array;
1332            }
1333            # force bit 0 on.
1334            $gmask |= 1;
1335
1336            $sth = $dbh->prepare("REPLACE INTO friends (userid, friendid, fgcolor, bgcolor, groupmask) ".
1337                                 "VALUES ($userid, $friendid, $qfg, $qbg, $gmask)");
1338            $sth->execute;
1339            return fail($err,501,$dbh->errstr) if $dbh->err;
1340
1341        }
1342    }
1343
1344    return fail($err,104) if $error_flag;
1345    return $res;
1346}
1347
1348sub editfriendgroups
1349{
1350    my ($dbs, $req, $err, $flags) = @_;
1351    return undef unless authenticate($dbs, $req, $err, $flags);
1352
1353    my $u = $flags->{'u'};
1354    my $userid = $u->{'userid'};
1355    my $dbr = $dbs->{'reader'};
1356    my $dbh = $dbs->{'dbh'};
1357    my $sth;
1358
1359    return fail($err,306) unless $dbh;
1360    return fail($err,502) unless $dbr;
1361
1362    my $res = {};
1363
1364    ## make sure tree is how we want it
1365    $req->{'groupmasks'} = {} unless
1366        (ref $req->{'groupmasks'} eq "HASH");
1367    $req->{'set'} = {} unless
1368        (ref $req->{'set'} eq "HASH");
1369    $req->{'delete'} = [] unless
1370        (ref $req->{'delete'} eq "ARRAY");
1371
1372    ###
1373    ## Keep track of what bits are already set, so we can know later whether to INSERT
1374    #  or UPDATE.
1375
1376    my %bitset;
1377    $sth = $dbr->prepare("SELECT groupnum FROM friendgroup WHERE userid=$userid");
1378    $sth->execute;
1379    while (my ($bit) = $sth->fetchrow_array) {
1380        $bitset{$bit} = 1;
1381    }
1382
1383    ## figure out deletions we'll do later
1384    foreach my $bit (@{$req->{'delete'}})
1385    {
1386        $bit += 0;
1387        next unless ($bit >= 1 && $bit <= 30);
1388        $bitset{$bit} = 0;  # so later we replace into, not update.
1389    }
1390
1391    ## change friends' masks
1392    foreach my $friend (keys %{$req->{'groupmasks'}})
1393    {
1394        my $mask = int($req->{'groupmasks'}->{$friend}) | 1;
1395
1396        my $friendid = LJ::get_userid($dbs, $friend);
1397        if ($friendid) {
1398            $sth = $dbh->prepare("UPDATE friends SET groupmask=$mask ".
1399                                 "WHERE userid=$userid AND friendid=$friendid");
1400            $sth->execute;
1401        }
1402    }
1403
1404    ## do additions/modifications ('set' hash)
1405    my %added;
1406    foreach my $bit (keys %{$req->{'set'}})
1407    {
1408        $bit += 0;
1409        next unless ($bit >= 1 && $bit <= 30);
1410        my $sa = $req->{'set'}->{$bit};
1411        my $name = $sa->{'name'};
1412
1413        # setting it to name is like deleting it.
1414        unless ($name =~ /\S/) {
1415            push @{$req->{'delete'}}, $bit;
1416            next;
1417        }
1418
1419        my $qname = $dbh->quote($name);
1420        my $qsort = defined $sa->{'sort'} ? ($sa->{'sort'}+0) : 50;
1421        my $qpublic = $dbh->quote(defined $sa->{'public'} ? ($sa->{'public'}+0) : 0);
1422
1423        if ($bitset{$bit}) {
1424            # so update it
1425            my $sets;
1426            if (defined $sa->{'public'}) {
1427                $sets .= ", is_public=$qpublic";
1428            }
1429            $sth = $dbh->prepare("UPDATE friendgroup SET groupname=$qname, sortorder=$qsort ".
1430                                 "$sets WHERE userid=$userid AND groupnum=$bit");
1431        } else {
1432            $sth = $dbh->prepare("REPLACE INTO friendgroup (userid, groupnum, ".
1433                                 "groupname, sortorder, is_public) VALUES ".
1434                                 "($userid, $bit, $qname, $qsort, $qpublic)");
1435        }
1436        $sth->execute;
1437        $added{$bit} = 1;
1438    }
1439
1440
1441    ## do deletions ('delete' array)
1442    foreach my $bit (@{$req->{'delete'}})
1443    {
1444        $bit += 0;
1445        next unless ($bit >= 1 && $bit <= 30);
1446
1447        # Old note: remove all friend's priviledges on that bit
1448        # number?  No, client should do this.
1449
1450        # remove all posts from allowing that group:
1451        my @posts_to_clean = ();
1452        $sth = $dbr->prepare("SELECT itemid FROM logsec WHERE ownerid=$userid AND allowmask & (1 << $bit)");
1453        $sth->execute;
1454        while (my ($id) = $sth->fetchrow_array) { push @posts_to_clean, $id; }
1455        while (@posts_to_clean) {
1456            my @batch;
1457            if (scalar(@posts_to_clean) < 20) {
1458                @batch = @posts_to_clean;
1459                @posts_to_clean = ();
1460            } else {
1461                @batch = splice(@posts_to_clean, 0, 20);
1462            }
1463            my $in = join(",", @batch);
1464            $dbh->do("UPDATE log SET allowmask=allowmask & ~(1 << $bit) ".
1465                     "WHERE itemid IN ($in) AND security='usemask'");
1466            $dbh->do("UPDATE logsec SET allowmask=allowmask & ~(1 << $bit) ".
1467                     "WHERE ownerid=$userid AND itemid IN ($in)");
1468        }
1469
1470        # remove the friend group, unless we just added it this transaction
1471        unless ($added{$bit}) {
1472            $sth = $dbh->prepare("DELETE FROM friendgroup WHERE ".
1473                                 "userid=$userid AND groupnum=$bit");
1474            $sth->execute;
1475        }
1476    }
1477
1478    # return value for this is nothing.
1479    return {};
1480}
1481
1482sub list_friends
1483{
1484    my ($dbs, $u, $opts) = @_;
1485    my $dbr = $dbs->{'reader'};
1486
1487    my $limitnum = $opts->{'limit'}+0;
1488    my $where = "u.userid=f.friendid AND f.userid=$u->{'userid'}";
1489    if ($opts->{'friendof'}) {
1490        $where = "u.userid=f.userid AND f.friendid=$u->{'userid'}";
1491    }
1492
1493    my $limit = $limitnum ? "LIMIT $limitnum" : "";
1494    my $sth = $dbr->prepare("SELECT u.user AS 'friend', u.name, u.journaltype, f.fgcolor, f.bgcolor, f.groupmask ".
1495                            "FROM user u, friends f WHERE $where AND u.statusvis='V' ORDER BY u.user $limit");
1496    $sth->execute;
1497    my @friends;
1498    push @friends, $_ while $_ = $sth->fetchrow_hashref;
1499    $sth->finish;
1500
1501    my $res = [];
1502    foreach my $f (@friends)
1503    {
1504        my $r =  { 'username' => $f->{'friend'},
1505                   'fullname' => $f->{'name'},
1506               };
1507        $r->{'fgcolor'} = LJ::color_fromdb($f->{'fgcolor'});
1508        $r->{'bgcolor'} = LJ::color_fromdb($f->{'bgcolor'});
1509        if (! $opts->{'friendof'} && $f->{'groupmask'} != 1) {
1510            $r->{"groupmask"} = $f->{'groupmask'};
1511        }
1512        if ($f->{'journaltype'} eq "C") {
1513            $r->{"type"} = "community";
1514        }
1515
1516        push @$res, $r;
1517    }
1518    return $res;
1519}
1520
1521sub syncitems
1522{
1523    my ($dbs, $req, $err, $flags) = @_;
1524    return undef unless authenticate($dbs, $req, $err, $flags);
1525    return undef unless check_altusage($dbs, $req, $err, $flags);
1526
1527    my $ownerid = $flags->{'ownerid'};
1528    my $uowner = $flags->{'u_owner'} || $flags->{'u'};
1529    my $dbr = $dbs->{'reader'};
1530    my ($date, $sth);
1531
1532    # cluster differences
1533    my ($db, $table) = ($dbs->{'dbh'}, "syncupdates");
1534    ($db, $table) = (LJ::get_cluster_reader($uowner), "syncupdates2")
1535        if $uowner->{'clusterid'};
1536
1537    return fail($err,502) unless $db;
1538
1539    ## have a valid date?
1540    $date = $req->{'lastsync'};
1541    if ($date) {
1542        return fail($err,203,"Invalid date format")
1543            unless ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
1544    } else {
1545        $date = "0000-00-00 00:00:00";
1546    }
1547
1548    my $LIMIT = 500;
1549
1550    my $total = $db->selectrow_array("SELECT COUNT(*) FROM $table WHERE ".
1551                                     "userid=$ownerid AND atime >= '$date'");
1552
1553    $sth = $db->prepare("SELECT atime, nodetype, nodeid, atype FROM ".
1554                        "$table WHERE userid=$ownerid AND ".
1555                        "atime >= '$date' ORDER BY atime LIMIT $LIMIT");
1556    $sth->execute;
1557    return fail($err,501,$db->errstr) if $db->err;
1558
1559    my $res = {};
1560    my $list = $res->{'syncitems'} = [];
1561    my $ct = 0;
1562    while (my ($atime, $nodetype, $nodeid, $atype) = $sth->fetchrow_array) {
1563        $ct++;
1564        push @$list, { 'item' => "$nodetype-$nodeid",
1565                       'action' => $atype,
1566                       'time' => $atime,
1567                   };
1568    }
1569    $res->{'count'} = $ct;
1570    $res->{'total'} = $total;
1571    return $res;
1572}
1573
1574sub consolecommand
1575{
1576    my ($dbs, $req, $err, $flags) = @_;
1577
1578    # TODO: LJ::Con doesn't yet support $dbs/$dbarg
1579    my $dbh = $dbs->{'dbh'};
1580    return fail($err,502) unless $dbh;
1581
1582    # logging in isn't necessary, but most console commands do require it
1583    my $remote = undef;
1584    $remote = $flags->{'u'} if authenticate($dbs, $req, $err, $flags);
1585
1586    my $res = {};
1587    my $cmdout = $res->{'results'} = [];
1588
1589    foreach my $cmd (@{$req->{'commands'}})
1590    {
1591        # callee can pre-parse the args, or we can do it bash-style
1592        $cmd = [ LJ::Con::parse_line($cmd) ] unless (ref $cmd eq "ARRAY");
1593
1594        my @output;
1595        my $rv = LJ::Con::execute($dbh, $remote, $cmd, \@output);
1596        push @{$cmdout}, {
1597            'success' => $rv,
1598            'output' => \@output,
1599        };
1600    }
1601
1602    return $res;
1603}
1604
1605sub login_message
1606{
1607    my ($dbs, $req, $res, $flags) = @_;
1608
1609    my $u = $flags->{'u'};
1610
1611    if ($u eq "test") {
1612        $res->{'message'} = "Hello Test Account!";
1613    }
1614    if ($req->{'clientversion'} =~ /^Win32-MFC\/(1.2.[0123456])$/ ||
1615        $req->{'clientversion'} =~ /^Win32-MFC\/(1.3.[01234])\b/)
1616    {
1617        $res->{'message'} = "There's a significantly newer version of LiveJournal for Windows available.";
1618    }
1619    unless ($LJ::EVERYONE_VALID)
1620    {
1621        if ($u->{'status'} eq "N") { $res->{'message'} = "You are currently not validated.  You may continue to use LiveJournal, but please validate your email address for continued use.  See the instructions that were mailed to you when you created your journal, or see $LJ::SITEROOT/support/ for more information."; }
1622        if ($u->{'status'} eq "T") { $res->{'message'} = "You need to validate your new email address.  Your old one was good, but since you've changed it, you need to re-validate the new one.  Visit the support area for more information."; }
1623    }
1624    if ($u->{'status'} eq "B") { $res->{'message'} = "You are currently using a bad email address.  All mail we try to send you is bouncing.  We require a valid email address for continued use.  Visit the support area for more information."; }
1625
1626    if (LJ::get_cap($u, "readonly")) {
1627        $res->{'message'} = "Your account is temporarily in read-only mode.  Some operations will fail for a few minutes.";
1628    }
1629
1630}
1631
1632sub list_friendgroups
1633{
1634    my $dbs = shift;
1635    my $u = shift;
1636
1637    my $res = [];
1638    my $dbr = $dbs->{'reader'};
1639
1640    my $sth = $dbr->prepare("SELECT groupnum, groupname, sortorder, is_public ".
1641                            "FROM friendgroup WHERE userid=$u->{'userid'} ".
1642                            "ORDER BY sortorder");
1643    $sth->execute;
1644    while (my ($gid, $name, $sort, $public) = $sth->fetchrow_array) {
1645        push @$res, { 'id' => $gid,
1646                      'name' => $name,
1647                      'sortorder' => $sort,
1648                      'public' => $public };
1649    }
1650    $sth->finish;
1651    return $res;
1652}
1653
1654sub list_usejournals
1655{
1656    my $dbs = shift;
1657    my $u = shift;
1658
1659    my $res = [];
1660
1661    my $dbr = $dbs->{'reader'};
1662    my $sth = $dbr->prepare("SELECT u.user FROM useridmap u, logaccess la ".
1663                            "WHERE la.ownerid=u.userid AND ".
1664                            "la.posterid=$u->{'userid'} ORDER BY u.user");
1665    $sth->execute;
1666    while (my $u = $sth->fetchrow_array) {
1667        push @$res, $u;
1668    }
1669    $sth->finish;
1670    return $res;
1671}
1672
1673sub hash_menus
1674{
1675    my $dbs = shift;
1676    my $u = shift;
1677    my $user = $u->{'user'};
1678
1679    my $menu = [
1680                { 'text' => "Recent Entries",
1681                  'url' => "$LJ::SITEROOT/users/$user/", },
1682                { 'text' => "Calendar View",
1683                  'url' => "$LJ::SITEROOT/users/$user/calendar", },
1684                { 'text' => "Friends View",
1685                  'url' => "$LJ::SITEROOT/users/$user/friends", },
1686                { 'text' => "-", },
1687                { 'text' => "Your Profile",
1688                  'url' => "$LJ::SITEROOT/userinfo.bml?user=$user", },
1689                { 'text' => "Your To-Do List",
1690                  'url' => "$LJ::SITEROOT/todo/?user=$user", },
1691                { 'text' => "-", },
1692                { 'text' => "Change Settings",
1693                  'sub' => [ { 'text' => "Personal Info",
1694                               'url' => "$LJ::SITEROOT/editinfo.bml", },
1695                             { 'text' => "Journal Settings",
1696                               'url' =>"$LJ::SITEROOT/modify.bml", }, ] },
1697                { 'text' => "-", },
1698                { 'text' => "Support",
1699                  'url' => "$LJ::SITEROOT/support/", }
1700                ];
1701
1702    LJ::run_hooks("modify_login_menu", {
1703        'dbs' => $dbs,
1704        'menu' => $menu,
1705        'u' => $u,
1706        'user' => $user,
1707    });
1708
1709    return $menu;
1710}
1711
1712sub list_pickws
1713{
1714    my $dbs = shift;
1715    my $u = shift;
1716
1717    my $dbr = $dbs->{'reader'};
1718    my $res = [];
1719
1720    my $sth = $dbr->prepare("SELECT k.keyword, m.picid FROM userpicmap m, keywords k ".
1721                            "WHERE m.userid=$u->{'userid'} AND m.kwid=k.kwid ".
1722                            "ORDER BY k.keyword");
1723    $sth->execute;
1724    while (my ($kw, $id) = $sth->fetchrow_array) {
1725        $kw =~ s/[\n\r\0]//g;  # used to be a bug that allowed these characters to get in.
1726        push @$res, [ $kw, $id ];
1727    }
1728    return $res;
1729}
1730
1731sub list_moods
1732{
1733    my $dbs = shift;
1734    my $mood_max = int(shift);
1735
1736    LJ::load_moods($dbs);
1737
1738    my $res = [];
1739    return $res unless ($mood_max < $LJ::CACHED_MOOD_MAX);
1740
1741    for (my $id = $mood_max+1; $id <= $LJ::CACHED_MOOD_MAX; $id++) {
1742        next unless defined $LJ::CACHE_MOODS{$id};
1743        my $mood = $LJ::CACHE_MOODS{$id};
1744        push @$res, { 'id' => $id,
1745                      'name' => $mood->{'name'},
1746                      'parent' => $mood->{'parent'} };
1747    }
1748
1749    return $res;
1750}
1751
1752sub check_altusage
1753{
1754    my ($dbs, $req, $err, $flags) = @_;
1755
1756    # see note in ljlib.pl::can_use_journal about why we return
1757    # both 'ownerid' and 'u_owner' in $flags
1758
1759    my $alt = $req->{'usejournal'};
1760    my $u = $flags->{'u'};
1761    $flags->{'ownerid'} = $u->{'userid'};
1762
1763    # all good if not using an alt journal
1764    return 1 unless $alt;
1765
1766    # complain if the username is invalid
1767    return fail($err,206) unless LJ::canonical_username($alt);
1768
1769    # allow usage if we're told explicitly that it's okay
1770    if ($flags->{'usejournal_okay'}) {
1771        $flags->{'u_owner'} = LJ::load_user($dbs, $alt);
1772        $flags->{'ownerid'} = $flags->{'u_owner'}->{'userid'};
1773        return 1 if $flags->{'ownerid'};
1774        return fail($err,206);
1775    }
1776
1777    # otherwise, check logaccess table:
1778    my $info = {};
1779    if (LJ::can_use_journal($dbs, $u->{'userid'}, $req->{'usejournal'}, $info)) {
1780        $flags->{'ownerid'} = $info->{'ownerid'};
1781        $flags->{'u_owner'} = $info->{'u_owner'};
1782        return 1;
1783    }
1784
1785    # not allowed to access it
1786    return fail($err,300);
1787}
1788
1789sub authenticate
1790{
1791    my ($dbs, $req, $err, $flags) = @_;
1792
1793    my $username = $req->{'username'};
1794    return fail($err,200) unless $username;
1795    return fail($err,100) unless LJ::canonical_username($username);
1796
1797    my $u = $flags->{'u'};
1798    unless ($u) {
1799        my $dbr = $dbs->{'reader'};
1800        return fail($err,502) unless $dbr;
1801        my $quser = $dbr->quote($username);
1802        my $sth = $dbr->prepare("SELECT user, userid, journaltype, name, ".
1803                                "password, status, statusvis, caps, ".
1804                                "clusterid, dversion, ".
1805                                "track FROM user WHERE user=$quser");
1806        $sth->execute;
1807        $u = $sth->fetchrow_hashref;
1808    }
1809
1810    return fail($err,100) unless $u;
1811    return fail($err,100) if ($u->{'statusvis'} eq "X");
1812    return fail($err,101) unless ($flags->{'nopassword'} ||
1813                                  $flags->{'noauth'} ||
1814                                    LJ::auth_okay($username,
1815                                                $req->{'password'},
1816                                                $req->{'hpassword'},
1817                                                $u->{'password'}));
1818    # remember the user record for later.
1819    $flags->{'u'} = $u;
1820    return 1;
1821}
1822
1823sub fail
1824{
1825    my $err = shift;
1826    my $code = shift;
1827    my $des = shift;
1828    $code .= ":$des" if $des;
1829    $$err = $code if (ref $err eq "SCALAR");
1830    return undef;
1831}
1832
1833#### Old interface (flat key/values) -- wrapper aruond LJ::Protocol
1834package LJ;
1835
1836sub do_request
1837{
1838    # get the request and response hash refs
1839    my ($db_arg, $req, $res, $flags) = @_;
1840
1841    # initialize some stuff
1842    my $dbs = LJ::make_dbs_from_arg($db_arg);
1843    my $dbh = $dbs->{'dbh'};
1844    my $dbr = $dbs->{'reader'};
1845    %{$res} = ();                      # clear the given response hash
1846    $flags = {} unless (ref $flags eq "HASH");
1847
1848    my ($user, $userid, $journaltype, $name, $correctpassword, $status, $statusvis, $track, $sth);
1849    $user = LJ::canonical_username($req->{'user'});
1850    my $quser = $dbh->quote($user);
1851
1852    # check for an alive database connection
1853    unless ($dbh) {
1854        $res->{'success'} = "FAIL";
1855        $res->{'errmsg'} = "Server error: cannot connect to database.";
1856        return;
1857    }
1858
1859    # did they send a mode?
1860    unless ($req->{'mode'}) {
1861        $res->{'success'} = "FAIL";
1862        $res->{'errmsg'} = "Client error: No mode specified.";
1863        return;
1864    }
1865
1866    unless ($user) {
1867        $res->{'success'} = "FAIL";
1868        $res->{'errmsg'} = "Client error: No username sent.";
1869        return;
1870    }
1871
1872    ### see if the server's under maintenance now
1873    if ($LJ::SERVER_DOWN) {
1874        $res->{'success'} = "FAIL";
1875        $res->{'errmsg'} = $LJ::SERVER_DOWN_MESSAGE;
1876        return;
1877    }
1878
1879    ## dispatch wrappers
1880    if ($req->{'mode'} eq "login") {
1881        return login($dbs, $req, $res, $flags);
1882    }
1883    if ($req->{'mode'} eq "getfriendgroups") {
1884        return getfriendgroups($dbs, $req, $res, $flags);
1885    }
1886    if ($req->{'mode'} eq "getfriends") {
1887        return getfriends($dbs, $req, $res, $flags);
1888    }
1889    if ($req->{'mode'} eq "friendof") {
1890        return friendof($dbs, $req, $res, $flags);
1891    }
1892    if ($req->{'mode'} eq "checkfriends") {
1893        return checkfriends($dbs, $req, $res, $flags);
1894    }
1895    if ($req->{'mode'} eq "getdaycounts") {
1896        return getdaycounts($dbs, $req, $res, $flags);
1897    }
1898    if ($req->{'mode'} eq "postevent") {
1899        return postevent($dbs, $req, $res, $flags);
1900    }
1901    if ($req->{'mode'} eq "editevent") {
1902        return editevent($dbs, $req, $res, $flags);
1903    }
1904    if ($req->{'mode'} eq "syncitems") {
1905        return syncitems($dbs, $req, $res, $flags);
1906    }
1907    if ($req->{'mode'} eq "getevents") {
1908        return getevents($dbs, $req, $res, $flags);
1909    }
1910    if ($req->{'mode'} eq "editfriends") {
1911        return editfriends($dbs, $req, $res, $flags);
1912    }
1913    if ($req->{'mode'} eq "editfriendgroups") {
1914        return editfriendgroups($dbs, $req, $res, $flags);
1915    }
1916    if ($req->{'mode'} eq "consolecommand") {
1917        return consolecommand($dbs, $req, $res, $flags);
1918    }
1919
1920    ### unknown mode!
1921    $res->{'success'} = "FAIL";
1922    $res->{'errmsg'} = "Client error: Unknown mode ($req->{'mode'})";
1923    return;
1924}
1925
1926## flat wrapper
1927sub login
1928{
1929    my ($dbs, $req, $res, $flags) = @_;
1930
1931    my $err = 0;
1932    my $rq = upgrade_request($req);
1933
1934    my $rs = LJ::Protocol::do_request($dbs, "login", $rq, \$err, $flags);
1935    unless ($rs) {
1936        $res->{'success'} = "FAIL";
1937        $res->{'errmsg'} = LJ::Protocol::error_message($err);
1938        return 0;
1939    }
1940
1941    $res->{'success'} = "OK";
1942    $res->{'name'} = $rs->{'fullname'};
1943    $res->{'message'} = $rs->{'message'} if $rs->{'message'};
1944    $res->{'fastserver'} = 1 if $rs->{'fastserver'};
1945
1946    # shared journals
1947    my $access_count = 0;
1948    foreach my $user (@{$rs->{'usejournals'}}) {
1949        $access_count++;
1950        $res->{"access_${access_count}"} = $user;
1951    }
1952    if ($access_count) {
1953        $res->{"access_count"} = $access_count;
1954    }
1955
1956    # friend groups
1957    populate_friend_groups($res, $rs->{'friendgroups'});
1958
1959    my $flatten = sub {
1960        my ($prefix, $listref) = @_;
1961        my $ct = 0;
1962        foreach (@$listref) {
1963            $ct++;
1964            $res->{"${prefix}_$ct"} = $_;
1965        }
1966        $res->{"${prefix}_count"} = $ct;
1967    };
1968
1969    ### picture keywords
1970    $flatten->("pickw", $rs->{'pickws'})
1971        if defined $req->{"getpickws"};
1972    $flatten->("pickwurl", $rs->{'pickwurls'})
1973        if defined $req->{"getpickwurls"};
1974
1975    ### report new moods that this client hasn't heard of, if they care
1976    if (defined $req->{"getmoods"}) {
1977        my $mood_count = 0;
1978        foreach my $m (@{$rs->{'moods'}}) {
1979            $mood_count++;
1980            $res->{"mood_${mood_count}_id"} = $m->{'id'};
1981            $res->{"mood_${mood_count}_name"} = $m->{'name'};
1982        }
1983        if ($mood_count) {
1984            $res->{"mood_count"} = $mood_count;
1985        }
1986    }
1987
1988    #### send web menus
1989    if ($req->{"getmenus"} == 1) {
1990        my $menu = $rs->{'menus'};
1991        my $menu_num = 0;
1992        populate_web_menu($res, $menu, \$menu_num);
1993    }
1994
1995    return 1;
1996}
1997
1998## flat wrapper
1999sub getfriendgroups
2000{
2001    my ($dbs, $req, $res, $flags) = @_;
2002
2003    my $err = 0;
2004    my $rq = upgrade_request($req);
2005
2006    my $rs = LJ::Protocol::do_request($dbs, "getfriendgroups", $rq, \$err, $flags);
2007    unless ($rs) {
2008        $res->{'success'} = "FAIL";
2009        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2010        return 0;
2011    }
2012    $res->{'success'} = "OK";
2013    populate_friend_groups($res, $rs->{'friendgroups'});
2014
2015    return 1;
2016}
2017
2018## flat wrapper
2019sub getfriends
2020{
2021    my ($dbs, $req, $res, $flags) = @_;
2022
2023    my $err = 0;
2024    my $rq = upgrade_request($req);
2025
2026    my $rs = LJ::Protocol::do_request($dbs, "getfriends", $rq, \$err, $flags);
2027    unless ($rs) {
2028        $res->{'success'} = "FAIL";
2029        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2030        return 0;
2031    }
2032
2033    $res->{'success'} = "OK";
2034    if ($req->{'includegroups'}) {
2035        populate_friend_groups($res, $rs->{'friendgroups'});
2036    }
2037    if ($req->{'includefriendof'}) {
2038        populate_friends($res, "friendof", $rs->{'friendofs'});
2039    }
2040    populate_friends($res, "friend", $rs->{'friends'});
2041
2042    return 1;
2043}
2044
2045## flat wrapper
2046sub friendof
2047{
2048    my ($dbs, $req, $res, $flags) = @_;
2049
2050    my $err = 0;
2051    my $rq = upgrade_request($req);
2052
2053    my $rs = LJ::Protocol::do_request($dbs, "friendof", $rq, \$err, $flags);
2054    unless ($rs) {
2055        $res->{'success'} = "FAIL";
2056        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2057        return 0;
2058    }
2059
2060    $res->{'success'} = "OK";
2061    populate_friends($res, "friendof", $rs->{'friendofs'});
2062    return 1;
2063}
2064
2065## flat wrapper
2066sub checkfriends
2067{
2068    my ($dbs, $req, $res, $flags) = @_;
2069
2070    my $err = 0;
2071    my $rq = upgrade_request($req);
2072
2073    my $rs = LJ::Protocol::do_request($dbs, "checkfriends", $rq, \$err, $flags);
2074    unless ($rs) {
2075        $res->{'success'} = "FAIL";
2076        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2077        return 0;
2078    }
2079
2080    $res->{'success'} = "OK";
2081    $res->{'new'} = $rs->{'new'};
2082    $res->{'lastupdate'} = $rs->{'lastupdate'};
2083    $res->{'interval'} = $rs->{'interval'};
2084    return 1;
2085}
2086
2087## flat wrapper
2088sub getdaycounts
2089{
2090    my ($dbs, $req, $res, $flags) = @_;
2091
2092    my $err = 0;
2093    my $rq = upgrade_request($req);
2094
2095    my $rs = LJ::Protocol::do_request($dbs, "getdaycounts", $rq, \$err, $flags);
2096    unless ($rs) {
2097        $res->{'success'} = "FAIL";
2098        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2099        return 0;
2100    }
2101
2102    $res->{'success'} = "OK";
2103    foreach my $d (@{ $rs->{'daycounts'} }) {
2104        $res->{$d->{'date'}} = $d->{'count'};
2105    }
2106    return 1;
2107}
2108
2109## flat wrapper
2110sub syncitems
2111{
2112    my ($dbs, $req, $res, $flags) = @_;
2113
2114    my $err = 0;
2115    my $rq = upgrade_request($req);
2116
2117    my $rs = LJ::Protocol::do_request($dbs, "syncitems", $rq, \$err, $flags);
2118    unless ($rs) {
2119        $res->{'success'} = "FAIL";
2120        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2121        return 0;
2122    }
2123
2124    $res->{'success'} = "OK";
2125    $res->{'sync_total'} = $rs->{'total'};
2126    $res->{'sync_count'} = $rs->{'count'};
2127
2128    my $ct = 0;
2129    foreach my $s (@{ $rs->{'syncitems'} }) {
2130        $ct++;
2131        foreach my $a (qw(item action time)) {
2132            $res->{"sync_${ct}_$a"} = $s->{$a};
2133        }
2134    }
2135    return 1;
2136}
2137
2138## flat wrapper: limited functionality.  (1 command only, server-parsed only)
2139sub consolecommand
2140{
2141    my ($dbs, $req, $res, $flags) = @_;
2142
2143    my $err = 0;
2144    my $rq = upgrade_request($req);
2145    delete $rq->{'command'};
2146
2147    $rq->{'commands'} = [ $req->{'command'} ];
2148
2149    my $rs = LJ::Protocol::do_request($dbs, "consolecommand", $rq, \$err, $flags);
2150    unless ($rs) {
2151        $res->{'success'} = "FAIL";
2152        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2153        return 0;
2154    }
2155
2156    $res->{'cmd_success'} = $rs->{'results'}->[0]->{'success'};
2157    $res->{'cmd_line_count'} = 0;
2158    foreach my $l (@{$rs->{'results'}->[0]->{'output'}}) {
2159        $res->{'cmd_line_count'}++;
2160        my $line = $res->{'cmd_line_count'};
2161        $res->{"cmd_line_${line}_type"} = $l->[0]
2162            if $l->[0];
2163        $res->{"cmd_line_${line}"} = $l->[1];
2164    }
2165
2166    $res->{'success'} = "OK";
2167
2168}
2169
2170## flat wrapper
2171sub editfriends
2172{
2173    my ($dbs, $req, $res, $flags) = @_;
2174
2175    my $err = 0;
2176    my $rq = upgrade_request($req);
2177
2178    $rq->{'add'} = [];
2179    $rq->{'delete'} = [];
2180
2181    foreach (keys %$req) {
2182        if (/^editfriend_add_(\d+)_user$/) {
2183            my $n = $1;
2184            next unless ($req->{"editfriend_add_${n}_user"} =~ /\S/);
2185            my $fa = { 'username' => $req->{"editfriend_add_${n}_user"},
2186                       'fgcolor' => $req->{"editfriend_add_${n}_fg"},
2187                       'bgcolor' => $req->{"editfriend_add_${n}_bg"},
2188                       'groupmask' => $req->{"editfriend_add_${n}_groupmask"},
2189                   };
2190            push @{$rq->{'add'}}, $fa;
2191        } elsif (/^editfriend_delete_(\w+)$/) {
2192            push @{$rq->{'delete'}}, $1;
2193        }
2194    }
2195
2196    my $rs = LJ::Protocol::do_request($dbs, "editfriends", $rq, \$err, $flags);
2197    unless ($rs) {
2198        $res->{'success'} = "FAIL";
2199        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2200        return 0;
2201    }
2202
2203    $res->{'success'} = "OK";
2204
2205    my $ct = 0;
2206    foreach my $fa (@{ $rs->{'added'} }) {
2207        $ct++;
2208        $res->{"friend_${ct}_user"} = $fa->{'username'};
2209        $res->{"friend_${ct}_name"} = $fa->{'fullname'};
2210    }
2211
2212    $res->{'friends_added'} = $ct;
2213
2214    return 1;
2215}
2216
2217## flat wrapper
2218sub editfriendgroups
2219{
2220    my ($dbs, $req, $res, $flags) = @_;
2221
2222    my $err = 0;
2223    my $rq = upgrade_request($req);
2224
2225    $rq->{'groupmasks'} = {};
2226    $rq->{'set'} = {};
2227    $rq->{'delete'} = [];
2228
2229    foreach (keys %$req) {
2230        if (/^efg_set_(\d+)_name$/) {
2231            next unless ($req->{$_} ne "");
2232            my $n = $1;
2233            my $fs = {
2234                'name' => $req->{"efg_set_${n}_name"},
2235                'sort' => $req->{"efg_set_${n}_sort"},
2236            };
2237            if (defined $req->{"efg_set_${n}_public"}) {
2238                $fs->{'public'} = $req->{"efg_set_${n}_public"};
2239            }
2240            $rq->{'set'}->{$n} = $fs;
2241        }
2242        elsif (/^efg_delete_(\d+)$/) {
2243            if ($req->{$_}) {
2244                # delete group if value is true
2245                push @{$rq->{'delete'}}, $1;
2246            }
2247        }
2248        elsif (/^editfriend_groupmask_(\w+)$/) {
2249            $rq->{'groupmasks'}->{$1} = $req->{$_};
2250        }
2251    }
2252
2253    my $rs = LJ::Protocol::do_request($dbs, "editfriendgroups", $rq, \$err, $flags);
2254    unless ($rs) {
2255        $res->{'success'} = "FAIL";
2256        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2257        return 0;
2258    }
2259
2260    $res->{'success'} = "OK";
2261    return 1;
2262}
2263
2264sub flatten_props
2265{
2266    my ($req, $rq) = @_;
2267
2268    ## changes prop_* to props hashref
2269    foreach my $k (keys %$req) {
2270        next unless ($k =~ /^prop_(.+)/);
2271        $rq->{'props'}->{$1} = $req->{$k};
2272    }
2273}
2274
2275## flat wrapper
2276sub postevent
2277{
2278    my ($dbs, $req, $res, $flags) = @_;
2279
2280    my $err = 0;
2281    my $rq = upgrade_request($req);
2282    flatten_props($req, $rq);
2283
2284    my $rs = LJ::Protocol::do_request($dbs, "postevent", $rq, \$err, $flags);
2285    unless ($rs) {
2286        $res->{'success'} = "FAIL";
2287        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2288        return 0;
2289    }
2290
2291    $res->{'success'} = "OK";
2292    $res->{'itemid'} = $rs->{'itemid'};
2293    $res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
2294    return 1;
2295}
2296
2297## flat wrapper
2298sub editevent
2299{
2300    my ($dbs, $req, $res, $flags) = @_;
2301
2302    my $err = 0;
2303    my $rq = upgrade_request($req);
2304    flatten_props($req, $rq);
2305
2306    my $rs = LJ::Protocol::do_request($dbs, "editevent", $rq, \$err, $flags);
2307    unless ($rs) {
2308        $res->{'success'} = "FAIL";
2309        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2310        return 0;
2311    }
2312
2313    $res->{'success'} = "OK";
2314    $res->{'itemid'} = $rs->{'itemid'};
2315    $res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
2316    return 1;
2317}
2318
2319## flat wrapper
2320sub getevents
2321{
2322    my ($dbs, $req, $res, $flags) = @_;
2323
2324    my $err = 0;
2325    my $rq = upgrade_request($req);
2326
2327    my $rs = LJ::Protocol::do_request($dbs, "getevents", $rq, \$err, $flags);
2328    unless ($rs) {
2329        $res->{'success'} = "FAIL";
2330        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2331        return 0;
2332    }
2333
2334    my $ect = 0;
2335    my $pct = 0;
2336    foreach my $evt (@{$rs->{'events'}}) {
2337        $ect++;
2338        foreach my $f (qw(itemid eventtime security allowmask subject anum)) {
2339            if (defined $evt->{$f}) {
2340                $res->{"events_${ect}_$f"} = $evt->{$f};
2341            }
2342        }
2343        $res->{"events_${ect}_event"} = LJ::eurl($evt->{'event'});
2344
2345        if ($evt->{'props'}) {
2346            foreach my $k (sort keys %{$evt->{'props'}}) {
2347                $pct++;
2348                $res->{"prop_${pct}_itemid"} = $evt->{'itemid'};
2349                $res->{"prop_${pct}_name"} = $k;
2350                $res->{"prop_${pct}_value"} = $evt->{'props'}->{$k};
2351            }
2352        }
2353    }
2354
2355    unless ($req->{'noprops'}) {
2356        $res->{'prop_count'} = $pct;
2357    }
2358    $res->{'events_count'} = $ect;
2359    $res->{'success'} = "OK";
2360
2361    return 1;
2362}
2363
2364
2365sub populate_friends
2366{
2367    my ($res, $pfx, $list) = @_;
2368    my $count = 0;
2369    foreach my $f (@$list)
2370    {
2371        $count++;
2372        $res->{"${pfx}_${count}_name"} = $f->{'fullname'};
2373        $res->{"${pfx}_${count}_user"} = $f->{'username'};
2374        $res->{"${pfx}_${count}_bg"} = $f->{'bgcolor'};
2375        $res->{"${pfx}_${count}_fg"} = $f->{'fgcolor'};
2376        if (defined $f->{'groupmask'}) {
2377            $res->{"${pfx}_${count}_groupmask"} = $f->{'groupmask'};
2378        }
2379        if (defined $f->{'type'}) {
2380            $res->{"${pfx}_${count}_type"} = $f->{'type'};
2381        }
2382    }
2383    $res->{"${pfx}_count"} = $count;
2384}
2385
2386
2387sub upgrade_request
2388{
2389    my $r = shift;
2390    my $new = { %{ $r } };
2391    $new->{'username'} = $r->{'user'};
2392
2393    # but don't delete $r->{'user'}, as it might be, say, %FORM,
2394    # that'll get reused in a later request in, say, update.bml after
2395    # the login before postevent.  whoops.
2396
2397    return $new;
2398}
2399
2400## given a $res hashref and friend group subtree (arrayref), flattens it
2401sub populate_friend_groups
2402{
2403    my ($res, $fr) = @_;
2404
2405    my $maxnum = 0;
2406    foreach my $fg (@$fr)
2407    {
2408        my $num = $fg->{'id'};
2409        $res->{"frgrp_${num}_name"} = $fg->{'name'};
2410        $res->{"frgrp_${num}_sortorder"} = $fg->{'sortorder'};
2411        if ($fg->{'public'}) {
2412            $res->{"frgrp_${num}_public"} = 1;
2413        }
2414        if ($num > $maxnum) { $maxnum = $num; }
2415    }
2416    $res->{'frgrp_maxnum'} = $maxnum;
2417}
2418
2419## given a menu tree, flattens it into $res hashref
2420sub populate_web_menu
2421{
2422    my ($res, $menu, $numref) = @_;
2423    my $mn = $$numref;  # menu number
2424    my $mi = 0;         # menu item
2425    foreach my $it (@$menu) {
2426        $mi++;
2427        $res->{"menu_${mn}_${mi}_text"} = $it->{'text'};
2428        if ($it->{'text'} eq "-") { next; }
2429        if ($it->{'sub'}) {
2430            $$numref++;
2431            $res->{"menu_${mn}_${mi}_sub"} = $$numref;
2432            &populate_web_menu($res, $it->{'sub'}, $numref);
2433            next;
2434
2435        }
2436        $res->{"menu_${mn}_${mi}_url"} = $it->{'url'};
2437    }
2438    $res->{"menu_${mn}_count"} = $mi;
2439}
2440
24411;
Note: See TracBrowser for help on using the browser.