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

Revision 895, 77.9 KB (checked in by bradfitz, 11 years ago)

[db maintenance robustness patch]
After all uses of LJ::get_dbh(), we need to check for undef first.
This is but the start. Tons more places need this.
  • 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    my @prefix = ("");
561    if ($LJ::USE_RECENT_TABLES) { push @prefix, "recent_"; }
562    foreach my $pfx (@prefix)
563    {
564        if ($clustered) {
565            # clustered recents have times now (for purger process.. can't use itemid key prefix)
566            my ($ec, $ev);
567            if ($pfx) { ($ec, $ev) = (", logtime", ", NOW()"); }
568            $dbcm->do("REPLACE INTO ${pfx}logtext2 (journalid, jitemid, subject, event $ec) ".
569                      "VALUES ($ownerid, $itemid, $qsubject, $qevent $ev)");
570            if ($dbcm->err) {
571                my $msg = $dbcm->errstr;
572                LJ::delete_item2($dbh, $dbcm, $ownerid, $itemid);   # roll-back
573                return fail($err,501,"logtext:$msg");
574            }
575        } else {
576            $dbh->do("INSERT INTO ${pfx}logtext (itemid, subject, event) ".
577                     "VALUES ($itemid, $qsubject, $qevent)");
578            if ($dbh->err) {
579                my $msg = $dbh->errstr;
580                LJ::delete_item($dbh, $ownerid, $itemid);   # roll-back
581                return fail($err,501,$msg);
582            }
583        }
584    }
585
586    # this is to speed month view and other places that don't need full text.
587    if ($clustered) {
588        $dbcm->do("REPLACE INTO logsubject2 (journalid, jitemid, subject) ".
589                  "VALUES ($ownerid, $itemid, $qsubject)");
590        if ($dbcm->err) {
591            my $msg = $dbcm->errstr;
592            LJ::delete_item2($dbh, $dbcm, $ownerid, $itemid);   # roll-back
593            return fail($err,501,"logsubject:$msg");
594        }
595    } else {
596        $dbh->do("INSERT INTO logsubject (itemid, subject) VALUES ($itemid, $qsubject)");
597        if ($dbh->err) {
598            my $msg = $dbh->errstr;
599            LJ::delete_item($dbh, $ownerid, $itemid);   # roll-back
600            return fail($err,501,$msg);
601        }
602    }
603
604    ## update sync table (selected from log table, so logtime is identical!)
605    if ($clustered) {
606        $dbcm->do("REPLACE INTO syncupdates2 (userid, atime, nodetype, nodeid, atype) ".
607                  "SELECT journalid, logtime, 'L', jitemid, 'create' FROM log2 ".
608                  "WHERE journalid=$ownerid AND jitemid=$itemid");
609        if ($dbcm->err) {
610            my $msg = $dbcm->errstr;
611            LJ::delete_item2($dbh, $dbcm, $ownerid, $itemid);   # roll-back
612            return fail($err,501,$msg);
613        }
614    } else {
615        $dbh->do("REPLACE INTO syncupdates (userid, atime, nodetype, nodeid, atype) ".
616                 "SELECT ownerid, logtime, 'L', itemid, 'create' FROM log WHERE itemid=$itemid");
617        if ($dbh->err) {
618            my $msg = $dbh->errstr;
619            LJ::delete_item($dbh, $ownerid, $itemid);   # roll-back
620            return fail($err,501,$msg);
621        }
622    }
623
624    # keep track of custom security stuff in other table.
625    if ($uselogsec) {
626        if ($clustered) {
627            $dbcm->do("REPLACE INTO logsec2 (journalid, jitemid, allowmask) ".
628                      "VALUES ($qownerid, $itemid, $qallowmask)");
629            if ($dbcm->err) {
630                my $msg = $dbcm->errstr;
631                LJ::delete_item2($dbh, $dbcm, $ownerid, $itemid);   # roll-back
632                return fail($err,501,"logsec2:$msg");
633            }
634        } else {
635            $dbh->do("INSERT INTO logsec (ownerid, itemid, allowmask) ".
636                     "VALUES ($qownerid, $itemid, $qallowmask)");
637            if ($dbh->err) {
638                my $msg = $dbh->errstr;
639                LJ::delete_item($dbh, $ownerid, $itemid);   # roll-back
640                return fail($err,501,$msg);
641            }
642        }
643    }
644
645    # meta-data
646    if (%{$req->{'props'}}) {
647        my $propinsert = "";
648        foreach my $pname (keys %{$req->{'props'}}) {
649            next unless $req->{'props'}->{$pname};
650            if ($propinsert) {
651                $propinsert .= ", ";
652            } else {
653                if ($clustered) {
654                    $propinsert = "REPLACE INTO logprop2 (journalid, jitemid, propid, value) VALUES ";
655                } else {
656                    $propinsert = "INSERT INTO logprop (itemid, propid, value) VALUES ";
657                }
658            }
659            my $p = LJ::get_prop("log", $pname);
660            if ($p) {
661                my $qvalue = $dbh->quote($req->{'props'}->{$pname});
662                if ($clustered) {
663                    $propinsert .= "($ownerid, $itemid, $p->{'id'}, $qvalue)";
664                } else {
665                    $propinsert .= "($itemid, $p->{'id'}, $qvalue)";
666                }
667            }
668        }
669        if ($propinsert) {
670            $dbcm->do($propinsert);   # note: $dbcm may be $dbh
671            if ($dbcm->err) {
672                my $msg = $dbh->errstr;
673                if ($clustered) {
674                    LJ::delete_item2($dbh, $dbcm, $ownerid, $itemid);   # roll-back
675                } else {
676                    LJ::delete_item($dbh, $ownerid, $itemid);   # roll-back
677                }
678                return fail($err,501,"logprop2:$msg");
679            }
680        }
681    }
682
683    $dbh->do("UPDATE userusage SET timeupdate=NOW(), lastitemid=$itemid ".
684             "WHERE userid=$qownerid");
685
686    if ($u->{'track'} eq "yes") {
687        # dear community, relax.  if we get a court order to provide data on somebody,
688        # we're legally required to.  this doesn't enable us to do that.  it enables
689        # us to do it without killing the database and/or servers as we do O(n) scans
690        # over everything and grep the hell out of hundreds of gigs of webserver logs.
691        my $quserid = $u->{'userid'}+0;
692        my $qip = $dbh->quote($ENV{'REMOTE_ADDR'});
693        $dbh->do("INSERT INTO tracking (userid, acttime, ip, actdes, associd) ".
694                 "VALUES ($quserid, NOW(), $qip, 'post', $itemid)");
695    }
696
697    my $res = {};
698    $res->{'itemid'} = $itemid;  # by request of mart
699    $res->{'anum'} = $anum if $clustered;
700    return $res;
701}
702
703sub editevent
704{
705    my ($dbs, $req, $err, $flags) = @_;
706    return undef unless authenticate($dbs, $req, $err, $flags);
707    return undef unless check_altusage($dbs, $req, $err, $flags);
708
709    my $u = $flags->{'u'};
710    my $ownerid = $flags->{'ownerid'};
711    my $uowner = $flags->{'u_owner'} || $u;
712    my $posterid = $u->{'userid'};
713    my $dbr = $dbs->{'reader'};
714    my $dbh = $dbs->{'dbh'};
715    my $sth;
716
717    my $qitemid = $req->{'itemid'}+0;
718
719    # check the journal's read-only bit
720    return fail($err,306) if LJ::get_cap($uowner, "readonly");
721
722    my ($dbcm, $dbcr, $clustered) = ($dbh, $dbr, 0);
723    if ($uowner->{'clusterid'}) {
724        $dbcm = LJ::get_cluster_master($uowner);
725        $clustered = 1;
726    }
727    return fail($err,306) unless $dbcm;
728
729    # fetch the old entry from master database so we know what we
730    # really have to update later.  usually people just edit one part,
731    # not every field in every table.  reads are quicker than writes,
732    # so this is worth it.
733    my $oldevent;
734    if ($clustered)
735    {
736        $oldevent = $dbcm->selectrow_hashref
737            ("SELECT l.journalid AS 'ownerid', l.posterid, l.eventtime, l.logtime, ".
738             "l.compressed, l.security, l.allowmask, l.year, l.month, l.day, lt.subject, ".
739             "MD5(lt.event) AS 'md5event', l.rlogtime, l.anum FROM log2 l, logtext2 lt ".
740             "WHERE l.journalid=$ownerid AND lt.journalid=$ownerid ".
741             "AND l.jitemid=$qitemid AND lt.jitemid=$qitemid");
742    } else {
743        $oldevent = $dbcm->selectrow_hashref
744            ("SELECT l.ownerid, l.posterid, l.eventtime, l.logtime, ".
745             "l.compressed, l.security, l.allowmask, l.year, l.month, l.day, lt.subject, ".
746             "MD5(lt.event) AS 'md5event', l.rlogtime FROM log l, logtext lt ".
747             "WHERE l.itemid=$qitemid AND lt.itemid=$qitemid");
748    }
749
750    ### make sure this user is allowed to edit this entry
751    return fail($err,302)
752        unless ($ownerid == $oldevent->{'ownerid'});
753
754    ### what can they do to somebody elses entry?  (in shared journal)
755    if ($posterid != $oldevent->{'posterid'})
756    {
757        ## deleting.
758        return fail($err,304)
759            if ($req->{'event'} !~ /\S/ && !
760                ($ownerid == $u->{'userid'} ||
761                 # community account can delete it (ick)
762
763                 LJ::check_priv($dbr, $u,
764                                "sharedjournal", $req->{'usejournal'})
765                 # if user is a community maintainer they can delete
766                 # it too (good)
767                 ));
768
769        ## editing:
770        return fail($err,303)
771            if ($req->{'event'} =~ /\S/);
772    }
773
774    ## update sync table (before we actually do it!  in case updates
775    ## partially fail below)
776    if ($clustered) {
777        my $synctype = "update";
778        if ($req->{'event'} !~ /\S/) { $synctype = "del"; }
779        $dbcm->do("REPLACE INTO syncupdates2 (userid, atime, nodetype, nodeid, atype) ".
780                  "VALUES ($ownerid, NOW(), 'L', $qitemid, '$synctype')");
781    } else {
782        $dbh->do("REPLACE INTO syncupdates (userid, atime, nodetype, nodeid, atype) ".
783                 "VALUES ($ownerid, NOW(), 'L', $qitemid, 'update')");
784    }
785
786    # simple logic for deleting an entry
787    if ($req->{'event'} !~ /\S/)
788    {
789        if ($clustered) {
790            LJ::delete_item2($dbh, $dbcm, $ownerid, $req->{'itemid'},
791                             'quick', $oldevent->{'anum'});
792        } else {
793            LJ::delete_item($dbh, $ownerid, $req->{'itemid'});
794        }
795        my $res = { 'itemid' => $qitemid,
796                    'anum' => $oldevent->{'anum'} };
797        return $res;
798    }
799
800    # don't allow backdated posts in communities
801    return fail($err,152) if
802        ($req->{'props'}->{"opt_backdated"} &&
803         $uowner->{'journaltype'} ne "P");
804
805    # updating an entry:
806    return undef
807        unless common_event_validation($dbs, $req, $err, $flags);
808
809    ### load existing meta-data
810    my %curprops;
811
812    if ($clustered) {
813        LJ::load_props($dbs, "log");
814        LJ::load_log_props2($dbcm, $ownerid, [ $qitemid ], \%curprops);
815    } else {
816        LJ::load_log_props($dbh, [ $qitemid ], \%curprops);
817    }
818
819    ## handle meta-data (properties)
820    my %props_byname = ();
821    foreach my $key (keys %{$req->{'props'}}) {
822        ## changing to something else?
823        if ($curprops{$qitemid}->{$key} ne $req->{'props'}->{$key}) {
824            $props_byname{$key} = $req->{'props'}->{$key};
825        }
826    }
827
828    #### clean up the event text
829    my $event = $req->{'event'};
830
831    # remove surrounding whitespace
832    $event =~ s/^\s+//;
833    $event =~ s/\s+$//;
834
835    # convert line endings to unix format
836    if ($req->{'lineendings'} eq "mac") {
837        $event =~ s/\r/\n/g;
838    } else {
839        $event =~ s/\r//g;
840    }
841    my $qevent = $dbh->quote($event);
842    my $bytes = length($event) + length($req->{'subject'});
843    $event = "";
844
845    my $eventtime = sprintf("%04d-%02d-%02d %02d:%02d",
846                            map { $req->{$_} } qw(year mon day hour min));
847    my $qeventtime = $dbh->quote($eventtime);
848
849    my $qallowmask = $req->{'allowmask'}+0;
850    my $security = "public";
851    if ($req->{'security'} eq "private" || $req->{'security'} eq "usemask") {
852        $security = $req->{'security'};
853    }
854
855    my $qyear = $req->{'year'}+0;
856    my $qmonth = $req->{'mon'}+0;
857    my $qday = $req->{'day'}+0;
858
859    if ($qyear != $oldevent->{'year'} ||
860        $qmonth != $oldevent->{'month'} ||
861        $qday != $oldevent->{'day'} ||
862        $eventtime ne $oldevent->{'eventtime'} ||
863        $security ne $oldevent->{'security'} ||
864        $qallowmask != $oldevent->{'allowmask'}
865        )
866    {
867        my $qsecurity = $dbh->quote($security);
868        if ($clustered) {
869            $dbcm->do("UPDATE log2 SET eventtime=$qeventtime, revttime=$LJ::EndOfTime-".
870                      "UNIX_TIMESTAMP($qeventtime), year=$qyear, month=$qmonth, day=$qday, ".
871                      "security=$qsecurity, allowmask=$qallowmask WHERE journalid=$ownerid ".
872                      "AND jitemid=$qitemid");
873        } else {
874            $dbh->do("UPDATE log SET eventtime=$qeventtime, revttime=$LJ::EndOfTime-".
875                     "UNIX_TIMESTAMP($qeventtime), year=$qyear, month=$qmonth, day=$qday, ".
876                     "security=$qsecurity, allowmask=$qallowmask WHERE itemid=$qitemid");
877        }
878    }
879
880    if ($security ne $oldevent->{'security'} ||
881        $qallowmask != $oldevent->{'allowmask'})
882    {
883        if ($security eq "public" || $security eq "private") {
884            if ($clustered) {
885                $dbcm->do("DELETE FROM logsec2 WHERE journalid=$ownerid AND jitemid=$qitemid");
886            } else {
887                $dbh->do("DELETE FROM logsec WHERE ownerid=$ownerid AND itemid=$qitemid");
888            }
889        } else {
890            my $qsecurity = $dbh->quote($security);
891            if ($clustered) {
892                $dbcm->do("REPLACE INTO logsec2 (journalid, jitemid, allowmask) ".
893                          "VALUES ($ownerid, $qitemid, $qallowmask)");
894            } else {
895                $dbh->do("REPLACE INTO logsec (ownerid, itemid, allowmask) ".
896                         "VALUES ($ownerid, $qitemid, $qallowmask)");
897            }
898        }
899        return fail($err,501,$dbcm->errstr) if $dbcm->err;
900    }
901
902    if (Digest::MD5::md5_hex($event) ne $oldevent->{'md5event'} ||
903        $req->{'subject'} ne $oldevent->{'subject'})
904    {
905        my $qsubject = $dbh->quote($req->{'subject'});
906
907        my @prefix = ("");
908        if ($LJ::USE_RECENT_TABLES) { push @prefix, "recent_"; }
909        foreach my $pfx (@prefix) {
910            if ($clustered) {
911                $dbcm->do("UPDATE ${pfx}logtext2 SET event=$qevent, subject=$qsubject ".
912                          "WHERE journalid=$ownerid AND jitemid=$qitemid");
913            } else {
914                $dbh->do("UPDATE ${pfx}logtext SET event=$qevent, subject=$qsubject ".
915                         "WHERE itemid=$qitemid");
916            }
917            return fail($err,501,$dbcm->errstr) if $dbcm->err;
918        }
919        if ($clustered) {
920            $dbcm->do("REPLACE INTO logsubject2 (journalid, jitemid, subject) ".
921                      "VALUES ($ownerid, $qitemid, $qsubject)");
922        } else {
923            $dbh->do("REPLACE INTO logsubject (itemid, subject) ".
924                     "VALUES ($qitemid, $qsubject)");
925        }
926
927        # update disk usage
928        if ($clustered) {
929            LJ::dudata_set($dbcm, $ownerid, 'L', $qitemid, $bytes);
930        }
931
932        return fail($err,501,$dbcm->errstr) if $dbcm->err;
933    }
934
935    if (%{$req->{'props'}}) {
936        my $propinsert = "";
937        my @props_to_delete;
938        foreach my $pname (keys %{$req->{'props'}}) {
939            my $p = LJ::get_prop("log", $pname);
940            next unless $p;
941            my $val = $req->{'props'}->{$pname};
942            unless ($val) {
943                push @props_to_delete, $p->{'id'};
944                next;
945            }
946            if ($propinsert) {
947                $propinsert .= ", ";
948            } else {
949                if ($clustered) {
950                    $propinsert = "REPLACE INTO logprop2 (journalid, jitemid, propid, value) VALUES ";
951                } else {
952                    $propinsert = "REPLACE INTO logprop (itemid, propid, value) VALUES ";
953                }
954            }
955            my $qvalue = $dbh->quote($val);
956            if ($clustered) {
957                $propinsert .= "($ownerid, $qitemid, $p->{'id'}, $qvalue)";
958            } else {
959                $propinsert .= "($qitemid, $p->{'id'}, $qvalue)";
960            }
961        }
962        if ($propinsert) { $dbcm->do($propinsert); }
963        if (@props_to_delete) {
964            my $propid_in = join(", ", @props_to_delete);
965            if ($clustered) {
966                $dbcm->do("DELETE FROM logprop2 WHERE journalid=$ownerid AND ".
967                          "jitemid=$qitemid AND propid IN ($propid_in)");
968            } else {
969                $dbh->do("DELETE FROM logprop WHERE itemid=$qitemid AND propid IN ($propid_in)");
970            }
971        }
972    }
973
974    # deal with backdated changes.  if the entry's rlogtime is
975    # $EndOfTime, then it's backdated.  if they want that off, need to
976    # reset rlogtime to real reverse log time.  also need to set
977    # rlogtime to $EndOfTime if they're turning backdate on.
978    if ($req->{'props'}->{'opt_backdated'} eq "1" &&
979        $oldevent->{'rlogtime'} != $LJ::EndOfTime) {
980        if ($clustered) {
981            $dbh->do("UPDATE log SET rlogtime=$LJ::EndOfTime WHERE ".
982                     "itemid=$qitemid");
983        } else {
984            $dbcm->do("UPDATE log2 SET rlogtime=$LJ::EndOfTime WHERE ".
985                      "journalid=$ownerid AND jitemid=$qitemid");
986        }
987    }
988    if ($req->{'props'}->{'opt_backdated'} eq "0" &&
989        $oldevent->{'rlogtime'} == $LJ::EndOfTime) {
990        if ($clustered) {
991            $dbcm->do("UPDATE log2 SET rlogtime=$LJ::EndOfTime-UNIX_TIMESTAMP(logtime) ".
992                      "WHERE journalid=$ownerid AND jitemid=$qitemid");
993        } else {
994            $dbh->do("UPDATE log SET rlogtime=$LJ::EndOfTime-UNIX_TIMESTAMP(logtime) ".
995                     "WHERE itemid=$qitemid");
996        }
997    }
998
999    return fail($err,501,$dbcm->errstr) if $dbcm->err;
1000
1001    my $res = { 'itemid' => $qitemid };
1002    $res->{'anum'} = $oldevent->{'anum'} if defined $oldevent->{'anum'};
1003    return $res;
1004}
1005
1006sub getevents
1007{
1008    my ($dbs, $req, $err, $flags) = @_;
1009    return undef unless authenticate($dbs, $req, $err, $flags);
1010    return undef unless check_altusage($dbs, $req, $err, $flags);
1011
1012    my $u = $flags->{'u'};
1013    my $uowner = $flags->{'u_owner'} || $u;
1014
1015    ### shared-journal support
1016    my $posterid = $u->{'userid'};
1017    my $ownerid = $flags->{'ownerid'};
1018
1019    my $dbr = $dbs->{'reader'};
1020    my $dbh = $dbs->{'dbh'};
1021    my $sth;
1022
1023    my ($dbcr, $clustered) = ($dbr, 0);
1024    if ($uowner->{'clusterid'}) {
1025        $dbcr = LJ::get_cluster_reader($uowner);
1026        $clustered = 1;
1027    }
1028    return fail($err,502) unless $dbcr;
1029
1030    # if this is on, we sort things different (logtime vs. posttime)
1031    # to avoid timezone issues
1032    my $is_community = ($uowner->{'journaltype'} eq "C" ||
1033                        $uowner->{'journaltype'} eq "S");
1034
1035    # in some cases we'll use the master, to ensure there's no
1036    # replication delay.  useful cases: getting one item, use master
1037    # since user might have just made a typo and realizes it as they
1038    # post, or wants to append something they forgot, etc, etc.  in
1039    # other cases, slave is pretty sure to have it.
1040    my $use_master = 0;
1041
1042    # the benefit of this mode over actually doing 'lastn/1' is
1043    # the $use_master usage.
1044    if ($req->{'selecttype'} eq "one" && $req->{'itemid'} eq "-1") {
1045        $req->{'selecttype'} = "lastn";
1046        $req->{'howmany'} = 1;
1047        undef $req->{'itemid'};
1048        $use_master = 1;  # see note above.
1049    }
1050
1051    # build the query to get log rows.  each selecttype branch is
1052    # responsible for either populating the following 3 variables
1053    # OR just populating $sql
1054    my ($orderby, $where, $limit);
1055    my $sql;
1056    if ($req->{'selecttype'} eq "day")
1057    {
1058        return fail($err,203)
1059            unless ($req->{'year'} =~ /^\d\d\d\d$/ &&
1060                    $req->{'month'} =~ /^\d\d?$/ &&
1061                    $req->{'day'} =~ /^\d\d?$/ &&
1062                    $req->{'month'} >= 1 && $req->{'month'} <= 12 &&
1063                    $req->{'day'} >= 1 && $req->{'day'} <= 31);
1064
1065        my $qyear = $dbh->quote($req->{'year'});
1066        my $qmonth = $dbh->quote($req->{'month'});
1067        my $qday = $dbh->quote($req->{'day'});
1068        $where = "AND year=$qyear AND month=$qmonth AND day=$qday";
1069        $limit = "LIMIT 200";  # FIXME: unhardcode this constant (also in ljviews.pl)
1070
1071        # see note above about why the sort order is different
1072        $orderby = $is_community ? "ORDER BY logtime" : "ORDER BY eventtime";
1073    }
1074    elsif ($req->{'selecttype'} eq "lastn")
1075    {
1076        my $howmany = $req->{'howmany'} || 20;
1077        if ($howmany > 50) { $howmany = 50; }
1078        $howmany = $howmany + 0;
1079        $limit = "LIMIT $howmany";
1080
1081        # okay, follow me here... see how we add the revttime predicate
1082        # even if no beforedate key is present?  you're probably saying,
1083        # that's retarded -- you're saying: "revttime > 0", that's like
1084        # saying, "if entry occured at all."  yes yes, but that hints
1085        # mysql's braindead optimizer to use the right index.
1086        my $rtime_after = 0;
1087        my $rtime_what = $is_community ? "rlogtime" : "revttime";
1088        if ($req->{'beforedate'}) {
1089            return fail($err,203,"Invalid beforedate format.")
1090                unless ($req->{'beforedate'} =~
1091                        /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d$/);
1092            my $qd = $dbh->quote($req->{'beforedate'});
1093            $rtime_after = "$LJ::EndOfTime-UNIX_TIMESTAMP($qd)";
1094        }
1095        $where .= "AND $rtime_what > $rtime_after ";
1096        $orderby = "ORDER BY $rtime_what";
1097    }
1098    elsif ($req->{'selecttype'} eq "one")
1099    {
1100        my $id = $req->{'itemid'} + 0;
1101        $where = $clustered ? "AND jitemid=$id" : "AND itemid=$id";
1102    }
1103    elsif ($req->{'selecttype'} eq "syncitems")
1104    {
1105        my ($date);
1106        ## have a valid date?
1107        $date = $req->{'lastsync'} || "0000-00-00 00:00:00";
1108        if ($date !~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/) {
1109            return fail($err,203,"Invalid syncitems date format.");
1110        }
1111
1112        my $LIMIT = 300;
1113        if ($clustered) {
1114            $sql = "SELECT jitemid, eventtime, security, allowmask, anum ".
1115                "FROM log2 l, syncupdates2 s ".
1116                "WHERE s.userid=$ownerid AND l.journalid=$ownerid ".
1117                "AND s.atime>='$date' AND s.nodetype='L' AND s.nodeid=l.jitemid ".
1118                "AND s.nodeid=l.jitemid ORDER BY s.atime LIMIT $LIMIT";
1119        } else {
1120            $use_master = 1;
1121            $sql = "SELECT itemid, eventtime, security, allowmask ".
1122                "FROM log l, syncupdates s WHERE s.userid=$ownerid ".
1123                "AND s.atime>='$date' AND s.nodetype='L' AND s.nodeid=l.itemid ".
1124                "AND s.nodeid=l.itemid ORDER BY s.atime LIMIT $LIMIT";
1125        }
1126    }
1127    else
1128    {
1129        return fail($err,200,"Invalid selecttype.");
1130    }
1131
1132    # common SQL template:
1133    unless ($sql) {
1134        if ($clustered) {
1135            $sql = "SELECT jitemid, eventtime, security, allowmask, anum ".
1136                   "FROM log2 WHERE journalid=$ownerid $where $orderby $limit";
1137        } else {
1138            $sql = "SELECT itemid, eventtime, security, allowmask ".
1139                      "FROM log WHERE ownerid=$ownerid $where $orderby $limit";
1140        }
1141    }
1142
1143    # whatever selecttype might have wanted us to use the master db.
1144    $dbcr = $clustered ? LJ::get_cluster_master($uowner) : $dbh
1145        if $use_master;
1146
1147    return fail($err,502) unless $dbcr;
1148
1149    ## load the log rows
1150    ($sth = $dbcr->prepare($sql))->execute;
1151    return fail($err,501,$dbcr->errstr) if $dbcr->err;
1152
1153    my $count = 0;
1154    my @itemids = ();
1155    my $res = {};
1156    my $events = $res->{'events'} = [];
1157    my %evt_from_itemid;
1158
1159    while (my ($itemid, $eventtime, $sec, $mask, $anum) = $sth->fetchrow_array)
1160    {
1161        $count++;
1162        my $evt = {};
1163        $evt->{'itemid'} = $itemid;
1164        push @itemids, $itemid;
1165
1166        $evt_from_itemid{$itemid} = $evt;
1167
1168        $evt->{"eventtime"} = $eventtime;
1169        if ($sec ne "public") {
1170            $evt->{'security'} = $sec;
1171            $evt->{'allowmask'} = $mask if $sec eq "usemask";
1172        }
1173        $evt->{'anum'} = $anum if $clustered;
1174        push @$events, $evt;
1175    }
1176
1177    ## load the text
1178    my $text;
1179    my $gt_opts = {
1180        'prefersubjects' => $req->{'prefersubject'} ,
1181        'usemaster' => $use_master,
1182    };
1183    if ($clustered) {
1184        $text = LJ::get_logtext2($uowner, $gt_opts, @itemids);
1185    } else {
1186        $text = LJ::get_logtext($dbs, $gt_opts, @itemids);
1187    }
1188    foreach my $i (@itemids)
1189    {
1190        my $t = $text->{$i};
1191        my $evt = $evt_from_itemid{$i};
1192        if ($t->[0]) {
1193            $t->[0] =~ s/[\r\n]/ /g;
1194            $evt->{'subject'} = $t->[0];
1195        }
1196
1197        # truncate
1198        $t->[1] = substr($t->[1], 0, $req->{'truncate'}-3) . "..."
1199            if ($req->{'truncate'} >= 4 && length($t->[1]) > $req->{'truncate'});
1200
1201        # line endings
1202        $t->[1] =~ s/\r//g;
1203        if ($req->{'lineendings'} eq "unix") {
1204            # do nothing.  native format.
1205        } elsif ($req->{'lineendings'} eq "mac") {
1206            $t->[1] =~ s/\n/\r/g;
1207        } elsif ($req->{'lineendings'} eq "space") {
1208            $t->[1] =~ s/\n/ /g;
1209        } elsif ($req->{'lineendings'} eq "dots") {
1210            $t->[1] =~ s/\n/ ... /g;
1211        } else { # "pc" -- default
1212            $t->[1] =~ s/\n/\r\n/g;
1213        }
1214        $evt->{'event'} = $t->[1];
1215    }
1216
1217    unless ($req->{'noprops'})
1218    {
1219        ### do the properties now
1220        $count = 0;
1221        my %props = ();
1222        if ($clustered) {
1223            LJ::load_props($dbs, "log");
1224            LJ::load_log_props2($dbcr, $ownerid, \@itemids, \%props);
1225        } else {
1226            LJ::load_log_props($dbcr, \@itemids, \%props);
1227        }
1228        foreach my $itemid (keys %props) {
1229            my $evt = $evt_from_itemid{$itemid};
1230            $evt->{'props'} = {};
1231            foreach my $name (keys %{$props{$itemid}}) {
1232                my $value = $props{$itemid}->{$name};
1233                $value =~ s/\n/ /g;
1234                $evt->{'props'}->{$name} = $value;
1235            }
1236        }
1237    }
1238
1239    return $res;
1240}
1241
1242sub editfriends
1243{
1244    my ($dbs, $req, $err, $flags) = @_;
1245    return undef unless authenticate($dbs, $req, $err, $flags);
1246
1247    my $u = $flags->{'u'};
1248    my $userid = $u->{'userid'};
1249    my $dbr = $dbs->{'reader'};
1250    my $dbh = $dbs->{'dbh'};
1251    my $sth;
1252
1253    return fail($err,306) unless $dbh;
1254
1255    my $res = {};
1256
1257    ## first, figure out who the current friends are to save us work later
1258    my %curfriend;
1259    my $friend_count = 0;
1260    $sth = $dbh->prepare("SELECT u.user FROM user u, friends f ".
1261                         "WHERE u.userid=f.friendid AND f.userid=$userid ".
1262                         "AND u.statusvis='V'");
1263    $sth->execute;
1264    while (my ($friend) = $sth->fetchrow_array) {
1265        $curfriend{$friend} = 1;
1266        $friend_count++;
1267    }
1268    $sth->finish;
1269
1270    # perform the deletions
1271  DELETEFRIEND:
1272    foreach (@{$req->{'delete'}})
1273    {
1274        my $deluser = LJ::canonical_username($_);
1275        next DELETEFRIEND unless ($curfriend{$deluser});
1276
1277        my $friendid = LJ::get_userid($dbh, $deluser);
1278        $sth = $dbh->prepare("DELETE FROM friends ".
1279                             "WHERE userid=$userid AND friendid=$friendid");
1280        $sth->execute;
1281        $friend_count--;
1282    }
1283
1284    my $error_flag = 0;
1285    my $friends_added = 0;
1286
1287    # perform the adds
1288  ADDFRIEND:
1289    foreach my $fa (@{$req->{'add'}})
1290    {
1291        unless (ref $fa eq "HASH") {
1292            $fa = { 'username' => $fa };
1293        }
1294
1295        my $aname = LJ::canonical_username($fa->{'username'});
1296        unless ($aname) {
1297            $error_flag = 1;
1298            next ADDFRIEND;
1299        }
1300
1301        $friend_count++ unless $curfriend{$aname};
1302
1303        my $maxfriends = LJ::get_cap($u, "maxfriends");
1304        return fail($err,104,"Exceeded $maxfriends friends limit (now: $friend_count)")
1305            if ($friend_count > $maxfriends);
1306
1307        my $fg = $fa->{'fgcolor'} || "#000000";
1308        my $bg = $fa->{'bgcolor'} || "#FFFFFF";
1309        if ($fg !~ /^\#[0-9A-F]{6,6}$/i || $bg !~ /^\#[0-9A-F]{6,6}$/i) {
1310            return fail($err,203,"Invalid color values");
1311        }
1312
1313        my $row = LJ::load_user($dbs, $aname);
1314        unless ($row && $row->{'statusvis'} eq "V") {
1315            $error_flag = 1;
1316        } else {
1317            $friends_added++;
1318            my $added = { 'username' => $aname,
1319                          'fullname' => $row->{'name'},
1320                      };
1321            push @{$res->{'added'}}, $added;
1322
1323            my $qfg = LJ::color_todb($fg);
1324            my $qbg = LJ::color_todb($bg);
1325
1326            my $friendid = $row->{'userid'};
1327
1328            my $gmask = $fa->{'groupmask'};
1329            if (! $gmask && $curfriend{$aname}) {
1330                # if no group mask sent, use the existing one if this is an existing friend
1331                my $sth = $dbh->prepare("SELECT groupmask FROM friends ".
1332                                        "WHERE userid=$userid AND friendid=$friendid");
1333                $sth->execute;
1334                $gmask = $sth->fetchrow_array;
1335            }
1336            # force bit 0 on.
1337            $gmask |= 1;
1338
1339            $sth = $dbh->prepare("REPLACE INTO friends (userid, friendid, fgcolor, bgcolor, groupmask) ".
1340                                 "VALUES ($userid, $friendid, $qfg, $qbg, $gmask)");
1341            $sth->execute;
1342            return fail($err,501,$dbh->errstr) if $dbh->err;
1343
1344        }
1345    }
1346
1347    return fail($err,104) if $error_flag;
1348    return $res;
1349}
1350
1351sub editfriendgroups
1352{
1353    my ($dbs, $req, $err, $flags) = @_;
1354    return undef unless authenticate($dbs, $req, $err, $flags);
1355
1356    my $u = $flags->{'u'};
1357    my $userid = $u->{'userid'};
1358    my $dbr = $dbs->{'reader'};
1359    my $dbh = $dbs->{'dbh'};
1360    my $sth;
1361
1362    return fail($err,306) unless $dbh;
1363    return fail($err,502) unless $dbr;
1364
1365    my $res = {};
1366
1367    ## make sure tree is how we want it
1368    $req->{'groupmasks'} = {} unless
1369        (ref $req->{'groupmasks'} eq "HASH");
1370    $req->{'set'} = {} unless
1371        (ref $req->{'set'} eq "HASH");
1372    $req->{'delete'} = [] unless
1373        (ref $req->{'delete'} eq "ARRAY");
1374
1375    ###
1376    ## Keep track of what bits are already set, so we can know later whether to INSERT
1377    #  or UPDATE.
1378
1379    my %bitset;
1380    $sth = $dbr->prepare("SELECT groupnum FROM friendgroup WHERE userid=$userid");
1381    $sth->execute;
1382    while (my ($bit) = $sth->fetchrow_array) {
1383        $bitset{$bit} = 1;
1384    }
1385
1386    ## figure out deletions we'll do later
1387    foreach my $bit (@{$req->{'delete'}})
1388    {
1389        $bit += 0;
1390        next unless ($bit >= 1 && $bit <= 30);
1391        $bitset{$bit} = 0;  # so later we replace into, not update.
1392    }
1393
1394    ## change friends' masks
1395    foreach my $friend (keys %{$req->{'groupmasks'}})
1396    {
1397        my $mask = int($req->{'groupmasks'}->{$friend}) | 1;
1398
1399        my $friendid = LJ::get_userid($dbs, $friend);
1400        if ($friendid) {
1401            $sth = $dbh->prepare("UPDATE friends SET groupmask=$mask ".
1402                                 "WHERE userid=$userid AND friendid=$friendid");
1403            $sth->execute;
1404        }
1405    }
1406
1407    ## do additions/modifications ('set' hash)
1408    my %added;
1409    foreach my $bit (keys %{$req->{'set'}})
1410    {
1411        $bit += 0;
1412        next unless ($bit >= 1 && $bit <= 30);
1413        my $sa = $req->{'set'}->{$bit};
1414        my $name = $sa->{'name'};
1415
1416        # setting it to name is like deleting it.
1417        unless ($name =~ /\S/) {
1418            push @{$req->{'delete'}}, $bit;
1419            next;
1420        }
1421
1422        my $qname = $dbh->quote($name);
1423        my $qsort = defined $sa->{'sort'} ? ($sa->{'sort'}+0) : 50;
1424        my $qpublic = $dbh->quote(defined $sa->{'public'} ? ($sa->{'public'}+0) : 0);
1425
1426        if ($bitset{$bit}) {
1427            # so update it
1428            my $sets;
1429            if (defined $sa->{'public'}) {
1430                $sets .= ", is_public=$qpublic";
1431            }
1432            $sth = $dbh->prepare("UPDATE friendgroup SET groupname=$qname, sortorder=$qsort ".
1433                                 "$sets WHERE userid=$userid AND groupnum=$bit");
1434        } else {
1435            $sth = $dbh->prepare("REPLACE INTO friendgroup (userid, groupnum, ".
1436                                 "groupname, sortorder, is_public) VALUES ".
1437                                 "($userid, $bit, $qname, $qsort, $qpublic)");
1438        }
1439        $sth->execute;
1440        $added{$bit} = 1;
1441    }
1442
1443
1444    ## do deletions ('delete' array)
1445    foreach my $bit (@{$req->{'delete'}})
1446    {
1447        $bit += 0;
1448        next unless ($bit >= 1 && $bit <= 30);
1449
1450        # Old note: remove all friend's priviledges on that bit
1451        # number?  No, client should do this.
1452
1453        # remove all posts from allowing that group:
1454        my @posts_to_clean = ();
1455        $sth = $dbr->prepare("SELECT itemid FROM logsec WHERE ownerid=$userid AND allowmask & (1 << $bit)");
1456        $sth->execute;
1457        while (my ($id) = $sth->fetchrow_array) { push @posts_to_clean, $id; }
1458        while (@posts_to_clean) {
1459            my @batch;
1460            if (scalar(@posts_to_clean) < 20) {
1461                @batch = @posts_to_clean;
1462                @posts_to_clean = ();
1463            } else {
1464                @batch = splice(@posts_to_clean, 0, 20);
1465            }
1466            my $in = join(",", @batch);
1467            $dbh->do("UPDATE log SET allowmask=allowmask & ~(1 << $bit) ".
1468                     "WHERE itemid IN ($in) AND security='usemask'");
1469            $dbh->do("UPDATE logsec SET allowmask=allowmask & ~(1 << $bit) ".
1470                     "WHERE ownerid=$userid AND itemid IN ($in)");
1471        }
1472
1473        # remove the friend group, unless we just added it this transaction
1474        unless ($added{$bit}) {
1475            $sth = $dbh->prepare("DELETE FROM friendgroup WHERE ".
1476                                 "userid=$userid AND groupnum=$bit");
1477            $sth->execute;
1478        }
1479    }
1480
1481    # return value for this is nothing.
1482    return {};
1483}
1484
1485sub list_friends
1486{
1487    my ($dbs, $u, $opts) = @_;
1488    my $dbr = $dbs->{'reader'};
1489
1490    my $limitnum = $opts->{'limit'}+0;
1491    my $where = "u.userid=f.friendid AND f.userid=$u->{'userid'}";
1492    if ($opts->{'friendof'}) {
1493        $where = "u.userid=f.userid AND f.friendid=$u->{'userid'}";
1494    }
1495
1496    my $limit = $limitnum ? "LIMIT $limitnum" : "";
1497    my $sth = $dbr->prepare("SELECT u.user AS 'friend', u.name, u.journaltype, f.fgcolor, f.bgcolor, f.groupmask ".
1498                            "FROM user u, friends f WHERE $where AND u.statusvis='V' ORDER BY u.user $limit");
1499    $sth->execute;
1500    my @friends;
1501    push @friends, $_ while $_ = $sth->fetchrow_hashref;
1502    $sth->finish;
1503
1504    my $res = [];
1505    foreach my $f (@friends)
1506    {
1507        my $r =  { 'username' => $f->{'friend'},
1508                   'fullname' => $f->{'name'},
1509               };
1510        $r->{'fgcolor'} = LJ::color_fromdb($f->{'fgcolor'});
1511        $r->{'bgcolor'} = LJ::color_fromdb($f->{'bgcolor'});
1512        if (! $opts->{'friendof'} && $f->{'groupmask'} != 1) {
1513            $r->{"groupmask"} = $f->{'groupmask'};
1514        }
1515        if ($f->{'journaltype'} eq "C") {
1516            $r->{"type"} = "community";
1517        }
1518
1519        push @$res, $r;
1520    }
1521    return $res;
1522}
1523
1524sub syncitems
1525{
1526    my ($dbs, $req, $err, $flags) = @_;
1527    return undef unless authenticate($dbs, $req, $err, $flags);
1528    return undef unless check_altusage($dbs, $req, $err, $flags);
1529
1530    my $ownerid = $flags->{'ownerid'};
1531    my $uowner = $flags->{'u_owner'} || $flags->{'u'};
1532    my $dbr = $dbs->{'reader'};
1533    my ($date, $sth);
1534
1535    # cluster differences
1536    my ($db, $table) = ($dbs->{'dbh'}, "syncupdates");
1537    ($db, $table) = (LJ::get_cluster_reader($uowner), "syncupdates2")
1538        if $uowner->{'clusterid'};
1539
1540    return fail($err,502) unless $db;
1541
1542    ## have a valid date?
1543    $date = $req->{'lastsync'};
1544    if ($date) {
1545        return fail($err,203,"Invalid date format")
1546            unless ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
1547    } else {
1548        $date = "0000-00-00 00:00:00";
1549    }
1550
1551    my $LIMIT = 500;
1552
1553    my $total = $db->selectrow_array("SELECT COUNT(*) FROM $table WHERE ".
1554                                     "userid=$ownerid AND atime >= '$date'");
1555
1556    $sth = $db->prepare("SELECT atime, nodetype, nodeid, atype FROM ".
1557                        "$table WHERE userid=$ownerid AND ".
1558                        "atime >= '$date' ORDER BY atime LIMIT $LIMIT");
1559    $sth->execute;
1560    return fail($err,501,$db->errstr) if $db->err;
1561
1562    my $res = {};
1563    my $list = $res->{'syncitems'} = [];
1564    my $ct = 0;
1565    while (my ($atime, $nodetype, $nodeid, $atype) = $sth->fetchrow_array) {
1566        $ct++;
1567        push @$list, { 'item' => "$nodetype-$nodeid",
1568                       'action' => $atype,
1569                       'time' => $atime,
1570                   };
1571    }
1572    $res->{'count'} = $ct;
1573    $res->{'total'} = $total;
1574    return $res;
1575}
1576
1577sub consolecommand
1578{
1579    my ($dbs, $req, $err, $flags) = @_;
1580
1581    # TODO: LJ::Con doesn't yet support $dbs/$dbarg
1582    my $dbh = $dbs->{'dbh'};
1583    return fail($err,502) unless $dbh;
1584
1585    # logging in isn't necessary, but most console commands do require it
1586    my $remote = undef;
1587    $remote = $flags->{'u'} if authenticate($dbs, $req, $err, $flags);
1588
1589    my $res = {};
1590    my $cmdout = $res->{'results'} = [];
1591
1592    foreach my $cmd (@{$req->{'commands'}})
1593    {
1594        # callee can pre-parse the args, or we can do it bash-style
1595        $cmd = [ LJ::Con::parse_line($cmd) ] unless (ref $cmd eq "ARRAY");
1596
1597        my @output;
1598        my $rv = LJ::Con::execute($dbh, $remote, $cmd, \@output);
1599        push @{$cmdout}, {
1600            'success' => $rv,
1601            'output' => \@output,
1602        };
1603    }
1604
1605    return $res;
1606}
1607
1608sub login_message
1609{
1610    my ($dbs, $req, $res, $flags) = @_;
1611
1612    my $u = $flags->{'u'};
1613
1614    if ($u eq "test") {
1615        $res->{'message'} = "Hello Test Account!";
1616    }
1617    if ($req->{'clientversion'} =~ /^Win32-MFC\/(1.2.[0123456])$/ ||
1618        $req->{'clientversion'} =~ /^Win32-MFC\/(1.3.[01234])\b/)
1619    {
1620        $res->{'message'} = "There's a significantly newer version of LiveJournal for Windows available.";
1621    }
1622    unless ($LJ::EVERYONE_VALID)
1623    {
1624        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."; }
1625        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."; }
1626    }
1627    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."; }
1628
1629    if (LJ::get_cap($u, "readonly")) {
1630        $res->{'message'} = "Your account is temporarily in read-only mode.  Some operations will fail for a few minutes.";
1631    }
1632
1633}
1634
1635sub list_friendgroups
1636{
1637    my $dbs = shift;
1638    my $u = shift;
1639
1640    my $res = [];
1641    my $dbr = $dbs->{'reader'};
1642
1643    my $sth = $dbr->prepare("SELECT groupnum, groupname, sortorder, is_public ".
1644                            "FROM friendgroup WHERE userid=$u->{'userid'} ".
1645                            "ORDER BY sortorder");
1646    $sth->execute;
1647    while (my ($gid, $name, $sort, $public) = $sth->fetchrow_array) {
1648        push @$res, { 'id' => $gid,
1649                      'name' => $name,
1650                      'sortorder' => $sort,
1651                      'public' => $public };
1652    }
1653    $sth->finish;
1654    return $res;
1655}
1656
1657sub list_usejournals
1658{
1659    my $dbs = shift;
1660    my $u = shift;
1661
1662    my $res = [];
1663
1664    my $dbr = $dbs->{'reader'};
1665    my $sth = $dbr->prepare("SELECT u.user FROM useridmap u, logaccess la ".
1666                            "WHERE la.ownerid=u.userid AND ".
1667                            "la.posterid=$u->{'userid'} ORDER BY u.user");
1668    $sth->execute;
1669    while (my $u = $sth->fetchrow_array) {
1670        push @$res, $u;
1671    }
1672    $sth->finish;
1673    return $res;
1674}
1675
1676sub hash_menus
1677{
1678    my $dbs = shift;
1679    my $u = shift;
1680    my $user = $u->{'user'};
1681
1682    my $menu = [
1683                { 'text' => "Recent Entries",
1684                  'url' => "$LJ::SITEROOT/users/$user/", },
1685                { 'text' => "Calendar View",
1686                  'url' => "$LJ::SITEROOT/users/$user/calendar", },
1687                { 'text' => "Friends View",
1688                  'url' => "$LJ::SITEROOT/users/$user/friends", },
1689                { 'text' => "-", },
1690                { 'text' => "Your Profile",
1691                  'url' => "$LJ::SITEROOT/userinfo.bml?user=$user", },
1692                { 'text' => "Your To-Do List",
1693                  'url' => "$LJ::SITEROOT/todo/?user=$user", },
1694                { 'text' => "-", },
1695                { 'text' => "Change Settings",
1696                  'sub' => [ { 'text' => "Personal Info",
1697                               'url' => "$LJ::SITEROOT/editinfo.bml", },
1698                             { 'text' => "Journal Settings",
1699                               'url' =>"$LJ::SITEROOT/modify.bml", }, ] },
1700                { 'text' => "-", },
1701                { 'text' => "Support",
1702                  'url' => "$LJ::SITEROOT/support/", }
1703                ];
1704
1705    LJ::run_hooks("modify_login_menu", {
1706        'dbs' => $dbs,
1707        'menu' => $menu,
1708        'u' => $u,
1709        'user' => $user,
1710    });
1711
1712    return $menu;
1713}
1714
1715sub list_pickws
1716{
1717    my $dbs = shift;
1718    my $u = shift;
1719
1720    my $dbr = $dbs->{'reader'};
1721    my $res = [];
1722
1723    my $sth = $dbr->prepare("SELECT k.keyword, m.picid FROM userpicmap m, keywords k ".
1724                            "WHERE m.userid=$u->{'userid'} AND m.kwid=k.kwid ".
1725                            "ORDER BY k.keyword");
1726    $sth->execute;
1727    while (my ($kw, $id) = $sth->fetchrow_array) {
1728        $kw =~ s/[\n\r\0]//g;  # used to be a bug that allowed these characters to get in.
1729        push @$res, [ $kw, $id ];
1730    }
1731    return $res;
1732}
1733
1734sub list_moods
1735{
1736    my $dbs = shift;
1737    my $mood_max = int(shift);
1738
1739    LJ::load_moods($dbs);
1740
1741    my $res = [];
1742    return $res unless ($mood_max < $LJ::CACHED_MOOD_MAX);
1743
1744    for (my $id = $mood_max+1; $id <= $LJ::CACHED_MOOD_MAX; $id++) {
1745        next unless defined $LJ::CACHE_MOODS{$id};
1746        my $mood = $LJ::CACHE_MOODS{$id};
1747        push @$res, { 'id' => $id,
1748                      'name' => $mood->{'name'},
1749                      'parent' => $mood->{'parent'} };
1750    }
1751
1752    return $res;
1753}
1754
1755sub check_altusage
1756{
1757    my ($dbs, $req, $err, $flags) = @_;
1758
1759    # see note in ljlib.pl::can_use_journal about why we return
1760    # both 'ownerid' and 'u_owner' in $flags
1761
1762    my $alt = $req->{'usejournal'};
1763    my $u = $flags->{'u'};
1764    $flags->{'ownerid'} = $u->{'userid'};
1765
1766    # all good if not using an alt journal
1767    return 1 unless $alt;
1768
1769    # complain if the username is invalid
1770    return fail($err,206) unless LJ::canonical_username($alt);
1771
1772    # allow usage if we're told explicitly that it's okay
1773    if ($flags->{'usejournal_okay'}) {
1774        $flags->{'u_owner'} = LJ::load_user($dbs, $alt);
1775        $flags->{'ownerid'} = $flags->{'u_owner'}->{'userid'};
1776        return 1 if $flags->{'ownerid'};
1777        return fail($err,206);
1778    }
1779
1780    # otherwise, check logaccess table:
1781    my $info = {};
1782    if (LJ::can_use_journal($dbs, $u->{'userid'}, $req->{'usejournal'}, $info)) {
1783        $flags->{'ownerid'} = $info->{'ownerid'};
1784        $flags->{'u_owner'} = $info->{'u_owner'};
1785        return 1;
1786    }
1787
1788    # not allowed to access it
1789    return fail($err,300);
1790}
1791
1792sub authenticate
1793{
1794    my ($dbs, $req, $err, $flags) = @_;
1795
1796    my $username = $req->{'username'};
1797    return fail($err,200) unless $username;
1798    return fail($err,100) unless LJ::canonical_username($username);
1799
1800    my $u = $flags->{'u'};
1801    unless ($u) {
1802        my $dbr = $dbs->{'reader'};
1803        return fail($err,502) unless $dbr;
1804        my $quser = $dbr->quote($username);
1805        my $sth = $dbr->prepare("SELECT user, userid, journaltype, name, ".
1806                                "password, status, statusvis, caps, ".
1807                                "clusterid, dversion, ".
1808                                "track FROM user WHERE user=$quser");
1809        $sth->execute;
1810        $u = $sth->fetchrow_hashref;
1811    }
1812
1813    return fail($err,100) unless $u;
1814    return fail($err,100) if ($u->{'statusvis'} eq "X");
1815    return fail($err,101) unless ($flags->{'nopassword'} ||
1816                                  $flags->{'noauth'} ||
1817                                    LJ::auth_okay($username,
1818                                                $req->{'password'},
1819                                                $req->{'hpassword'},
1820                                                $u->{'password'}));
1821    # remember the user record for later.
1822    $flags->{'u'} = $u;
1823    return 1;
1824}
1825
1826sub fail
1827{
1828    my $err = shift;
1829    my $code = shift;
1830    my $des = shift;
1831    $code .= ":$des" if $des;
1832    $$err = $code if (ref $err eq "SCALAR");
1833    return undef;
1834}
1835
1836#### Old interface (flat key/values) -- wrapper aruond LJ::Protocol
1837package LJ;
1838
1839sub do_request
1840{
1841    # get the request and response hash refs
1842    my ($db_arg, $req, $res, $flags) = @_;
1843
1844    # initialize some stuff
1845    my $dbs = LJ::make_dbs_from_arg($db_arg);
1846    my $dbh = $dbs->{'dbh'};
1847    my $dbr = $dbs->{'reader'};
1848    %{$res} = ();                      # clear the given response hash
1849    $flags = {} unless (ref $flags eq "HASH");
1850
1851    my ($user, $userid, $journaltype, $name, $correctpassword, $status, $statusvis, $track, $sth);
1852    $user = LJ::canonical_username($req->{'user'});
1853    my $quser = $dbh->quote($user);
1854
1855    # check for an alive database connection
1856    unless ($dbh) {
1857        $res->{'success'} = "FAIL";
1858        $res->{'errmsg'} = "Server error: cannot connect to database.";
1859        return;
1860    }
1861
1862    # did they send a mode?
1863    unless ($req->{'mode'}) {
1864        $res->{'success'} = "FAIL";
1865        $res->{'errmsg'} = "Client error: No mode specified.";
1866        return;
1867    }
1868
1869    unless ($user) {
1870        $res->{'success'} = "FAIL";
1871        $res->{'errmsg'} = "Client error: No username sent.";
1872        return;
1873    }
1874
1875    ### see if the server's under maintenance now
1876    if ($LJ::SERVER_DOWN) {
1877        $res->{'success'} = "FAIL";
1878        $res->{'errmsg'} = $LJ::SERVER_DOWN_MESSAGE;
1879        return;
1880    }
1881
1882    ## dispatch wrappers
1883    if ($req->{'mode'} eq "login") {
1884        return login($dbs, $req, $res, $flags);
1885    }
1886    if ($req->{'mode'} eq "getfriendgroups") {
1887        return getfriendgroups($dbs, $req, $res, $flags);
1888    }
1889    if ($req->{'mode'} eq "getfriends") {
1890        return getfriends($dbs, $req, $res, $flags);
1891    }
1892    if ($req->{'mode'} eq "friendof") {
1893        return friendof($dbs, $req, $res, $flags);
1894    }
1895    if ($req->{'mode'} eq "checkfriends") {
1896        return checkfriends($dbs, $req, $res, $flags);
1897    }
1898    if ($req->{'mode'} eq "getdaycounts") {
1899        return getdaycounts($dbs, $req, $res, $flags);
1900    }
1901    if ($req->{'mode'} eq "postevent") {
1902        return postevent($dbs, $req, $res, $flags);
1903    }
1904    if ($req->{'mode'} eq "editevent") {
1905        return editevent($dbs, $req, $res, $flags);
1906    }
1907    if ($req->{'mode'} eq "syncitems") {
1908        return syncitems($dbs, $req, $res, $flags);
1909    }
1910    if ($req->{'mode'} eq "getevents") {
1911        return getevents($dbs, $req, $res, $flags);
1912    }
1913    if ($req->{'mode'} eq "editfriends") {
1914        return editfriends($dbs, $req, $res, $flags);
1915    }
1916    if ($req->{'mode'} eq "editfriendgroups") {
1917        return editfriendgroups($dbs, $req, $res, $flags);
1918    }
1919    if ($req->{'mode'} eq "consolecommand") {
1920        return consolecommand($dbs, $req, $res, $flags);
1921    }
1922
1923    ### unknown mode!
1924    $res->{'success'} = "FAIL";
1925    $res->{'errmsg'} = "Client error: Unknown mode ($req->{'mode'})";
1926    return;
1927}
1928
1929## flat wrapper
1930sub login
1931{
1932    my ($dbs, $req, $res, $flags) = @_;
1933
1934    my $err = 0;
1935    my $rq = upgrade_request($req);
1936
1937    my $rs = LJ::Protocol::do_request($dbs, "login", $rq, \$err, $flags);
1938    unless ($rs) {
1939        $res->{'success'} = "FAIL";
1940        $res->{'errmsg'} = LJ::Protocol::error_message($err);
1941        return 0;
1942    }
1943
1944    $res->{'success'} = "OK";
1945    $res->{'name'} = $rs->{'fullname'};
1946    $res->{'message'} = $rs->{'message'} if $rs->{'message'};
1947    $res->{'fastserver'} = 1 if $rs->{'fastserver'};
1948
1949    # shared journals
1950    my $access_count = 0;
1951    foreach my $user (@{$rs->{'usejournals'}}) {
1952        $access_count++;
1953        $res->{"access_${access_count}"} = $user;
1954    }
1955    if ($access_count) {
1956        $res->{"access_count"} = $access_count;
1957    }
1958
1959    # friend groups
1960    populate_friend_groups($res, $rs->{'friendgroups'});
1961
1962    my $flatten = sub {
1963        my ($prefix, $listref) = @_;
1964        my $ct = 0;
1965        foreach (@$listref) {
1966            $ct++;
1967            $res->{"${prefix}_$ct"} = $_;
1968        }
1969        $res->{"${prefix}_count"} = $ct;
1970    };
1971
1972    ### picture keywords
1973    $flatten->("pickw", $rs->{'pickws'})
1974        if defined $req->{"getpickws"};
1975    $flatten->("pickwurl", $rs->{'pickwurls'})
1976        if defined $req->{"getpickwurls"};
1977
1978    ### report new moods that this client hasn't heard of, if they care
1979    if (defined $req->{"getmoods"}) {
1980        my $mood_count = 0;
1981        foreach my $m (@{$rs->{'moods'}}) {
1982            $mood_count++;
1983            $res->{"mood_${mood_count}_id"} = $m->{'id'};
1984            $res->{"mood_${mood_count}_name"} = $m->{'name'};
1985        }
1986        if ($mood_count) {
1987            $res->{"mood_count"} = $mood_count;
1988        }
1989    }
1990
1991    #### send web menus
1992    if ($req->{"getmenus"} == 1) {
1993        my $menu = $rs->{'menus'};
1994        my $menu_num = 0;
1995        populate_web_menu($res, $menu, \$menu_num);
1996    }
1997
1998    return 1;
1999}
2000
2001## flat wrapper
2002sub getfriendgroups
2003{
2004    my ($dbs, $req, $res, $flags) = @_;
2005
2006    my $err = 0;
2007    my $rq = upgrade_request($req);
2008
2009    my $rs = LJ::Protocol::do_request($dbs, "getfriendgroups", $rq, \$err, $flags);
2010    unless ($rs) {
2011        $res->{'success'} = "FAIL";
2012        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2013        return 0;
2014    }
2015    $res->{'success'} = "OK";
2016    populate_friend_groups($res, $rs->{'friendgroups'});
2017
2018    return 1;
2019}
2020
2021## flat wrapper
2022sub getfriends
2023{
2024    my ($dbs, $req, $res, $flags) = @_;
2025
2026    my $err = 0;
2027    my $rq = upgrade_request($req);
2028
2029    my $rs = LJ::Protocol::do_request($dbs, "getfriends", $rq, \$err, $flags);
2030    unless ($rs) {
2031        $res->{'success'} = "FAIL";
2032        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2033        return 0;
2034    }
2035
2036    $res->{'success'} = "OK";
2037    if ($req->{'includegroups'}) {
2038        populate_friend_groups($res, $rs->{'friendgroups'});
2039    }
2040    if ($req->{'includefriendof'}) {
2041        populate_friends($res, "friendof", $rs->{'friendofs'});
2042    }
2043    populate_friends($res, "friend", $rs->{'friends'});
2044
2045    return 1;
2046}
2047
2048## flat wrapper
2049sub friendof
2050{
2051    my ($dbs, $req, $res, $flags) = @_;
2052
2053    my $err = 0;
2054    my $rq = upgrade_request($req);
2055
2056    my $rs = LJ::Protocol::do_request($dbs, "friendof", $rq, \$err, $flags);
2057    unless ($rs) {
2058        $res->{'success'} = "FAIL";
2059        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2060        return 0;
2061    }
2062
2063    $res->{'success'} = "OK";
2064    populate_friends($res, "friendof", $rs->{'friendofs'});
2065    return 1;
2066}
2067
2068## flat wrapper
2069sub checkfriends
2070{
2071    my ($dbs, $req, $res, $flags) = @_;
2072
2073    my $err = 0;
2074    my $rq = upgrade_request($req);
2075
2076    my $rs = LJ::Protocol::do_request($dbs, "checkfriends", $rq, \$err, $flags);
2077    unless ($rs) {
2078        $res->{'success'} = "FAIL";
2079        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2080        return 0;
2081    }
2082
2083    $res->{'success'} = "OK";
2084    $res->{'new'} = $rs->{'new'};
2085    $res->{'lastupdate'} = $rs->{'lastupdate'};
2086    $res->{'interval'} = $rs->{'interval'};
2087    return 1;
2088}
2089
2090## flat wrapper
2091sub getdaycounts
2092{
2093    my ($dbs, $req, $res, $flags) = @_;
2094
2095    my $err = 0;
2096    my $rq = upgrade_request($req);
2097
2098    my $rs = LJ::Protocol::do_request($dbs, "getdaycounts", $rq, \$err, $flags);
2099    unless ($rs) {
2100        $res->{'success'} = "FAIL";
2101        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2102        return 0;
2103    }
2104
2105    $res->{'success'} = "OK";
2106    foreach my $d (@{ $rs->{'daycounts'} }) {
2107        $res->{$d->{'date'}} = $d->{'count'};
2108    }
2109    return 1;
2110}
2111
2112## flat wrapper
2113sub syncitems
2114{
2115    my ($dbs, $req, $res, $flags) = @_;
2116
2117    my $err = 0;
2118    my $rq = upgrade_request($req);
2119
2120    my $rs = LJ::Protocol::do_request($dbs, "syncitems", $rq, \$err, $flags);
2121    unless ($rs) {
2122        $res->{'success'} = "FAIL";
2123        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2124        return 0;
2125    }
2126
2127    $res->{'success'} = "OK";
2128    $res->{'sync_total'} = $rs->{'total'};
2129    $res->{'sync_count'} = $rs->{'count'};
2130
2131    my $ct = 0;
2132    foreach my $s (@{ $rs->{'syncitems'} }) {
2133        $ct++;
2134        foreach my $a (qw(item action time)) {
2135            $res->{"sync_${ct}_$a"} = $s->{$a};
2136        }
2137    }
2138    return 1;
2139}
2140
2141## flat wrapper: limited functionality.  (1 command only, server-parsed only)
2142sub consolecommand
2143{
2144    my ($dbs, $req, $res, $flags) = @_;
2145
2146    my $err = 0;
2147    my $rq = upgrade_request($req);
2148    delete $rq->{'command'};
2149
2150    $rq->{'commands'} = [ $req->{'command'} ];
2151
2152    my $rs = LJ::Protocol::do_request($dbs, "consolecommand", $rq, \$err, $flags);
2153    unless ($rs) {
2154        $res->{'success'} = "FAIL";
2155        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2156        return 0;
2157    }
2158
2159    $res->{'cmd_success'} = $rs->{'results'}->[0]->{'success'};
2160    $res->{'cmd_line_count'} = 0;
2161    foreach my $l (@{$rs->{'results'}->[0]->{'output'}}) {
2162        $res->{'cmd_line_count'}++;
2163        my $line = $res->{'cmd_line_count'};
2164        $res->{"cmd_line_${line}_type"} = $l->[0]
2165            if $l->[0];
2166        $res->{"cmd_line_${line}"} = $l->[1];
2167    }
2168
2169    $res->{'success'} = "OK";
2170
2171}
2172
2173## flat wrapper
2174sub editfriends
2175{
2176    my ($dbs, $req, $res, $flags) = @_;
2177
2178    my $err = 0;
2179    my $rq = upgrade_request($req);
2180
2181    $rq->{'add'} = [];
2182    $rq->{'delete'} = [];
2183
2184    foreach (keys %$req) {
2185        if (/^editfriend_add_(\d+)_user$/) {
2186            my $n = $1;
2187            next unless ($req->{"editfriend_add_${n}_user"} =~ /\S/);
2188            my $fa = { 'username' => $req->{"editfriend_add_${n}_user"},
2189                       'fgcolor' => $req->{"editfriend_add_${n}_fg"},
2190                       'bgcolor' => $req->{"editfriend_add_${n}_bg"},
2191                       'groupmask' => $req->{"editfriend_add_${n}_groupmask"},
2192                   };
2193            push @{$rq->{'add'}}, $fa;
2194        } elsif (/^editfriend_delete_(\w+)$/) {
2195            push @{$rq->{'delete'}}, $1;
2196        }
2197    }
2198
2199    my $rs = LJ::Protocol::do_request($dbs, "editfriends", $rq, \$err, $flags);
2200    unless ($rs) {
2201        $res->{'success'} = "FAIL";
2202        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2203        return 0;
2204    }
2205
2206    $res->{'success'} = "OK";
2207
2208    my $ct = 0;
2209    foreach my $fa (@{ $rs->{'added'} }) {
2210        $ct++;
2211        $res->{"friend_${ct}_user"} = $fa->{'username'};
2212        $res->{"friend_${ct}_name"} = $fa->{'fullname'};
2213    }
2214
2215    $res->{'friends_added'} = $ct;
2216
2217    return 1;
2218}
2219
2220## flat wrapper
2221sub editfriendgroups
2222{
2223    my ($dbs, $req, $res, $flags) = @_;
2224
2225    my $err = 0;
2226    my $rq = upgrade_request($req);
2227
2228    $rq->{'groupmasks'} = {};
2229    $rq->{'set'} = {};
2230    $rq->{'delete'} = [];
2231
2232    foreach (keys %$req) {
2233        if (/^efg_set_(\d+)_name$/) {
2234            next unless ($req->{$_} ne "");
2235            my $n = $1;
2236            my $fs = {
2237                'name' => $req->{"efg_set_${n}_name"},
2238                'sort' => $req->{"efg_set_${n}_sort"},
2239            };
2240            if (defined $req->{"efg_set_${n}_public"}) {
2241                $fs->{'public'} = $req->{"efg_set_${n}_public"};
2242            }
2243            $rq->{'set'}->{$n} = $fs;
2244        }
2245        elsif (/^efg_delete_(\d+)$/) {
2246            if ($req->{$_}) {
2247                # delete group if value is true
2248                push @{$rq->{'delete'}}, $1;
2249            }
2250        }
2251        elsif (/^editfriend_groupmask_(\w+)$/) {
2252            $rq->{'groupmasks'}->{$1} = $req->{$_};
2253        }
2254    }
2255
2256    my $rs = LJ::Protocol::do_request($dbs, "editfriendgroups", $rq, \$err, $flags);
2257    unless ($rs) {
2258        $res->{'success'} = "FAIL";
2259        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2260        return 0;
2261    }
2262
2263    $res->{'success'} = "OK";
2264    return 1;
2265}
2266
2267sub flatten_props
2268{
2269    my ($req, $rq) = @_;
2270
2271    ## changes prop_* to props hashref
2272    foreach my $k (keys %$req) {
2273        next unless ($k =~ /^prop_(.+)/);
2274        $rq->{'props'}->{$1} = $req->{$k};
2275    }
2276}
2277
2278## flat wrapper
2279sub postevent
2280{
2281    my ($dbs, $req, $res, $flags) = @_;
2282
2283    my $err = 0;
2284    my $rq = upgrade_request($req);
2285    flatten_props($req, $rq);
2286
2287    my $rs = LJ::Protocol::do_request($dbs, "postevent", $rq, \$err, $flags);
2288    unless ($rs) {
2289        $res->{'success'} = "FAIL";
2290        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2291        return 0;
2292    }
2293
2294    $res->{'success'} = "OK";
2295    $res->{'itemid'} = $rs->{'itemid'};
2296    $res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
2297    return 1;
2298}
2299
2300## flat wrapper
2301sub editevent
2302{
2303    my ($dbs, $req, $res, $flags) = @_;
2304
2305    my $err = 0;
2306    my $rq = upgrade_request($req);
2307    flatten_props($req, $rq);
2308
2309    my $rs = LJ::Protocol::do_request($dbs, "editevent", $rq, \$err, $flags);
2310    unless ($rs) {
2311        $res->{'success'} = "FAIL";
2312        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2313        return 0;
2314    }
2315
2316    $res->{'success'} = "OK";
2317    $res->{'itemid'} = $rs->{'itemid'};
2318    $res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
2319    return 1;
2320}
2321
2322## flat wrapper
2323sub getevents
2324{
2325    my ($dbs, $req, $res, $flags) = @_;
2326
2327    my $err = 0;
2328    my $rq = upgrade_request($req);
2329
2330    my $rs = LJ::Protocol::do_request($dbs, "getevents", $rq, \$err, $flags);
2331    unless ($rs) {
2332        $res->{'success'} = "FAIL";
2333        $res->{'errmsg'} = LJ::Protocol::error_message($err);
2334        return 0;
2335    }
2336
2337    my $ect = 0;
2338    my $pct = 0;
2339    foreach my $evt (@{$rs->{'events'}}) {
2340        $ect++;
2341        foreach my $f (qw(itemid eventtime security allowmask subject anum)) {
2342            if (defined $evt->{$f}) {
2343                $res->{"events_${ect}_$f"} = $evt->{$f};
2344            }
2345        }
2346        $res->{"events_${ect}_event"} = LJ::eurl($evt->{'event'});
2347
2348        if ($evt->{'props'}) {
2349            foreach my $k (sort keys %{$evt->{'props'}}) {
2350                $pct++;
2351                $res->{"prop_${pct}_itemid"} = $evt->{'itemid'};
2352                $res->{"prop_${pct}_name"} = $k;
2353                $res->{"prop_${pct}_value"} = $evt->{'props'}->{$k};
2354            }
2355        }
2356    }
2357
2358    unless ($req->{'noprops'}) {
2359        $res->{'prop_count'} = $pct;
2360    }
2361    $res->{'events_count'} = $ect;
2362    $res->{'success'} = "OK";
2363
2364    return 1;
2365}
2366
2367
2368sub populate_friends
2369{
2370    my ($res, $pfx, $list) = @_;
2371    my $count = 0;
2372    foreach my $f (@$list)
2373    {
2374        $count++;
2375        $res->{"${pfx}_${count}_name"} = $f->{'fullname'};
2376        $res->{"${pfx}_${count}_user"} = $f->{'username'};
2377        $res->{"${pfx}_${count}_bg"} = $f->{'bgcolor'};
2378        $res->{"${pfx}_${count}_fg"} = $f->{'fgcolor'};
2379        if (defined $f->{'groupmask'}) {
2380            $res->{"${pfx}_${count}_groupmask"} = $f->{'groupmask'};
2381        }
2382        if (defined $f->{'type'}) {
2383            $res->{"${pfx}_${count}_type"} = $f->{'type'};
2384        }
2385    }
2386    $res->{"${pfx}_count"} = $count;
2387}
2388
2389
2390sub upgrade_request
2391{
2392    my $r = shift;
2393    my $new = { %{ $r } };
2394    $new->{'username'} = $r->{'user'};
2395
2396    # but don't delete $r->{'user'}, as it might be, say, %FORM,
2397    # that'll get reused in a later request in, say, update.bml after
2398    # the login before postevent.  whoops.
2399
2400    return $new;
2401}
2402
2403## given a $res hashref and friend group subtree (arrayref), flattens it
2404sub populate_friend_groups
2405{
2406    my ($res, $fr) = @_;
2407
2408    my $maxnum = 0;
2409    foreach my $fg (@$fr)
2410    {
2411        my $num = $fg->{'id'};
2412        $res->{"frgrp_${num}_name"} = $fg->{'name'};
2413        $res->{"frgrp_${num}_sortorder"} = $fg->{'sortorder'};
2414        if ($fg->{'public'}) {
2415            $res->{"frgrp_${num}_public"} = 1;
2416        }
2417        if ($num > $maxnum) { $maxnum = $num; }
2418    }
2419    $res->{'frgrp_maxnum'} = $maxnum;
2420}
2421
2422## given a menu tree, flattens it into $res hashref
2423sub populate_web_menu
2424{
2425    my ($res, $menu, $numref) = @_;
2426    my $mn = $$numref;  # menu number
2427    my $mi = 0;         # menu item
2428    foreach my $it (@$menu) {
2429        $mi++;
2430        $res->{"menu_${mn}_${mi}_text"} = $it->{'text'};
2431        if ($it->{'text'} eq "-") { next; }
2432        if ($it->{'sub'}) {
2433            $$numref++;
2434            $res->{"menu_${mn}_${mi}_sub"} = $$numref;
2435            &populate_web_menu($res, $it->{'sub'}, $numref);
2436            next;
2437
2438        }
2439        $res->{"menu_${mn}_${mi}_url"} = $it->{'url'};
2440    }
2441    $res->{"menu_${mn}_count"} = $mi;
2442}
2443
24441;
Note: See TracBrowser for help on using the browser.