#!/usr/bin/perl
#

use strict;
use Unicode::MapUTF8 ();

BEGIN {
    # declare some charset aliases
    # we need this at least for cases when the only name supported
    # by MapUTF8.pm isn't recognized by browsers
    # note: newer versions of MapUTF8 know these
    {
        my %alias = ( 'windows-1251' => 'cp1251',
                      'windows-1252' => 'cp1252',
                      'windows-1253' => 'cp1253', );
        foreach (keys %alias) {
            next if Unicode::MapUTF8::utf8_supported_charset($_);
            Unicode::MapUTF8::utf8_charset_alias($_, $alias{$_});
        }
    }
}

require "$ENV{'LJHOME'}/cgi-bin/ljpoll.pl";
require "$ENV{'LJHOME'}/cgi-bin/ljconfig.pl";
require "$ENV{'LJHOME'}/cgi-bin/console.pl";
require "$ENV{'LJHOME'}/cgi-bin/taglib.pl";

# have to do this else mailgate will croak with email posting, but only want
# to do it if the site has enabled the hack
require "$ENV{'LJHOME'}/cgi-bin/talklib.pl" if $LJ::NEW_ENTRY_CLEANUP_HACK;

#### New interface (meta handler) ... other handlers should call into this.
package LJ::Protocol;

# global declaration of this text since we use it in two places
our $CannotBeShown = '(cannot be shown)';

sub translate
{
    my ($u, $msg, $vars) = @_;

    LJ::load_user_props($u, "browselang") unless $u->{'browselang'};
    return LJ::Lang::get_text($u->{'browselang'}, "protocol.$msg", undef, $vars);
}

sub error_message
{
    my $code = shift;
    my $des;
    if ($code =~ /^(\d\d\d):(.+)/) {
        ($code, $des) = ($1, $2);
    }
    my %e = (
             # User Errors
             "100" => "Invalid username",
             "101" => "Invalid password",
             "102" => "Can't use custom/private security on shared/community journals.",
             "103" => "Poll error",
             "104" => "Error adding one or more friends",
             "105" => "Challenge expired",
             "150" => "Can't post as non-user",
             "151" => "Banned from journal",
             "152" => "Can't make back-dated entries in non-personal journal.",
             "153" => "Incorrect time value",
             "154" => "Can't add a redirected account as a friend",
             "155" => "Non-authenticated email address",
             "156" => sub { # to reload w/o restart
                 LJ::tosagree_str('protocol' => 'text') || 
                 LJ::tosagree_str('protocol' => 'title')
             },

             # Client Errors
             "200" => "Missing required argument(s)",
             "201" => "Unknown method",
             "202" => "Too many arguments",
             "203" => "Invalid argument(s)",
             "204" => "Invalid metadata datatype",
             "205" => "Unknown metadata",
             "206" => "Invalid destination journal username.",
             "207" => "Protocol version mismatch",
             "208" => "Invalid text encoding",
             "209" => "Parameter out of range",
             "210" => "Client tried to edit with corrupt data.  Preventing.",
             "211" => "Invalid or malformed tag list",

             # Access Errors
             "300" => "Don't have access to requested journal",
             "301" => "Access of restricted feature",
             "302" => "Can't edit post from requested journal",
             "303" => "Can't edit post in community journal",
             "304" => "Can't delete post in this community journal",
             "305" => "Action forbidden; account is suspended.",
             "306" => "This journal is temporarily in read-only mode.  Try again in a couple minutes.",
             "307" => "Selected journal no longer exists.",
             "308" => "Account is locked and cannot be used.",
             "309" => "Account is marked as a memorial.",
             "310" => "Account needs to be age verified before use.",
             "311" => "Access temporarily disabled.",
             "312" => "Not allowed to add tags to entries in this journal",
             "313" => "Must use existing tags for entries in this journal (can't create new ones)",

             # Limit errors
             "402" => "Your IP address is temporarily banned for exceeding the login failure rate.",
             "404" => "Cannot post",
             "405" => "Post frequency limit.",
             "406" => "Client is making repeated requests.  Perhaps it's broken?",
             "407" => "Moderation queue full",
             "408" => "Maximum queued posts for this community+poster combination reached.",
             "409" => "Post too large.",
             "410" => "Your trial account has expired.  Posting now disabled.",
             
             # Server Errors
             "500" => "Internal server error",
             "501" => "Database error",
             "502" => "Database temporarily unavailable",
             "503" => "Error obtaining necessary database lock",
             "504" => "Protocol mode no longer supported.",
             "505" => "Account data format on server is old and needs to be upgraded.", # cluster0
             "506" => "Journal sync temporarily unavailable.",
             );

    my $prefix = "";
    my $error = (ref $e{$code} eq 'CODE' ? $e{$code}->() : $e{$code}) || "BUG: Unknown error code!";
    if ($code >= 200) { $prefix = "Client error: "; }
    if ($code >= 500) { $prefix = "Server error: "; }
    my $totalerror = "$prefix$error";
    $totalerror .= ": $des" if $des;
    return $totalerror;
}

sub do_request
{
    # get the request and response hash refs
    my ($method, $req, $err, $flags) = @_;

    # if version isn't specified explicitly, it's version 0
    if (ref $req eq "HASH") {
        $req->{'ver'} = 0 unless defined $req->{'ver'};
    }

    $flags ||= {};
    my @args = ($req, $err, $flags);

    my $r = eval { Apache->request };
    $r->notes("codepath" => "protocol.$method") 
        if $r && ! $r->notes("codepath");

    if ($method eq "login")            { return login(@args);            }
    if ($method eq "getfriendgroups")  { return getfriendgroups(@args);  }
    if ($method eq "getfriends")       { return getfriends(@args);       }
    if ($method eq "friendof")         { return friendof(@args);         }
    if ($method eq "checkfriends")     { return checkfriends(@args);     }
    if ($method eq "getdaycounts")     { return getdaycounts(@args);     }
    if ($method eq "postevent")        { return postevent(@args);        }
    if ($method eq "editevent")        { return editevent(@args);        }
    if ($method eq "syncitems")        { return syncitems(@args);        }
    if ($method eq "getevents")        { return getevents(@args);        }
    if ($method eq "editfriends")      { return editfriends(@args);      }
    if ($method eq "editfriendgroups") { return editfriendgroups(@args); }
    if ($method eq "consolecommand")   { return consolecommand(@args);   }
    if ($method eq "getchallenge")     { return getchallenge(@args);     }
    if ($method eq "sessiongenerate")  { return sessiongenerate(@args);  }
    if ($method eq "sessionexpire")    { return sessionexpire(@args);    }

    $r->notes("codepath" => "") if $r;
    return fail($err,201);
}

sub login
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);

    my $u = $flags->{'u'};
    my $res = {};
    my $ver = $req->{'ver'};

    ## check for version mismatches
    ## non-Unicode installations can't handle versions >=1

    return fail($err,207, "This installation does not support Unicode clients")
        if $ver>=1 and not $LJ::UNICODE;

    # do not let locked people log in
    return fail($err, 308) if $u->{statusvis} eq 'L';

    ## return a message to the client to be displayed (optional)
    login_message($req, $res, $flags);
    LJ::text_out(\$res->{'message'}) if $ver>=1 and defined $res->{'message'};

    ## report what shared journals this user may post in
    $res->{'usejournals'} = list_usejournals($u);

    ## return their friend groups
    $res->{'friendgroups'} = list_friendgroups($u);
    return fail($err, 502, "Error loading friend groups") unless $res->{'friendgroups'};
    if ($ver >= 1) {
        foreach (@{$res->{'friendgroups'}}) {
            LJ::text_out(\$_->{'name'});
        }
    }

    ## if they gave us a number of moods to get higher than, then return them
    if (defined $req->{'getmoods'}) {
        $res->{'moods'} = list_moods($req->{'getmoods'});
        if ($ver >= 1) {
            # currently all moods are in English, but this might change
            foreach (@{$res->{'moods'}}) { LJ::text_out(\$_->{'name'}) }
        }
    }

    ### picture keywords, if they asked for them.
    if ($req->{'getpickws'}) {
        my $pickws = list_pickws($u);
        $res->{'pickws'} = [ map { $_->[0] } @$pickws ];
        if ($req->{'getpickwurls'}) {
            if ($u->{'defaultpicid'}) {
                 $res->{'defaultpicurl'} = "$LJ::USERPIC_ROOT/$u->{'defaultpicid'}/$u->{'userid'}";
            }
            $res->{'pickwurls'} = [ map {
                "$LJ::USERPIC_ROOT/$_->[1]/$u->{'userid'}"
            } @$pickws ];
        }
        if ($ver >= 1) {
            # validate all text
            foreach(@{$res->{'pickws'}}) { LJ::text_out(\$_); }
            foreach(@{$res->{'pickwurls'}}) { LJ::text_out(\$_); }
            LJ::text_out(\$res->{'defaultpicurl'});
        }
    }

    ## return client menu tree, if requested
    if ($req->{'getmenus'}) {
        $res->{'menus'} = hash_menus($u);
        if ($ver >= 1) {
            # validate all text, just in case, even though currently
            # it's all English
            foreach (@{$res->{'menus'}}) {
                LJ::text_out(\$_->{'text'});
                LJ::text_out(\$_->{'url'}); # should be redundant
            }
	}
    }

    ## tell some users they can hit the fast servers later.
    $res->{'fastserver'} = 1 if LJ::get_cap($u, "fastserver");

    ## user info
    $res->{'userid'} = $u->{'userid'};
    $res->{'fullname'} = $u->{'name'};
    LJ::text_out(\$res->{'fullname'}) if $ver >= 1;

    if ($req->{'clientversion'} =~ /^\S+\/\S+$/) {
        eval {
            my $r = Apache->request;            
            $r->notes("clientver", $req->{'clientversion'});
        };
    }

    ## update or add to clientusage table
    if ($req->{'clientversion'} =~ /^\S+\/\S+$/ && 
        ! $LJ::DISABLED{'clientversionlog'})
    {
        my $client = $req->{'clientversion'};

        return fail($err, 208, "Bad clientversion string")
            if $ver >= 1 and not LJ::text_in($client);

        my $dbh = LJ::get_db_writer();
        my $qclient = $dbh->quote($client);
        my $cu_sql = "REPLACE INTO clientusage (userid, clientid, lastlogin) " .
            "SELECT $u->{'userid'}, clientid, NOW() FROM clients WHERE client=$qclient";
        my $sth = $dbh->prepare($cu_sql);
        $sth->execute;
        unless ($sth->rows) {
            # only way this can be 0 is if client doesn't exist in clients table, so
            # we need to add a new row there, to get a new clientid for this new client:
            $dbh->do("INSERT INTO clients (client) VALUES ($qclient)");
            # and now we can do the query from before and it should work:
            $sth = $dbh->prepare($cu_sql);
            $sth->execute;
        }
    }

    return $res;
}

sub getfriendgroups
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);
    my $u = $flags->{'u'};
    my $res = {};
    $res->{'friendgroups'} = list_friendgroups($u);
    return fail($err, 502, "Error loading friend groups") unless $res->{'friendgroups'};
    if ($req->{'ver'} >= 1) {
        foreach (@{$res->{'friendgroups'} || []}) {
            LJ::text_out(\$_->{'name'});
        }
    }
    return $res;
}

sub getfriends
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);
    return fail($req,502) unless LJ::get_db_reader();
    my $u = $flags->{'u'};
    my $res = {};
    if ($req->{'includegroups'}) {
        $res->{'friendgroups'} = list_friendgroups($u);
        return fail($err, 502, "Error loading friend groups") unless $res->{'friendgroups'};
        if ($req->{'ver'} >= 1) {
            foreach (@{$res->{'friendgroups'} || []}) {
                LJ::text_out(\$_->{'name'});
            }
        }
    }
    # TAG:FR:protocol:getfriends_of
    if ($req->{'includefriendof'}) {
        $res->{'friendofs'} = list_friends($u, {
            'limit' => $req->{'friendoflimit'},
            'friendof' => 1,
        });
        if ($req->{'ver'} >= 1) {
            foreach(@{$res->{'friendofs'}}) { LJ::text_out(\$_->{'fullname'}) };
        }
    }
    # TAG:FR:protocol:getfriends
    $res->{'friends'} = list_friends($u, {
        'limit' => $req->{'friendlimit'},
        'includebdays' => $req->{'includebdays'},
    });
    if ($req->{'ver'} >= 1) {
        foreach(@{$res->{'friends'}}) { LJ::text_out(\$_->{'fullname'}) };
    }
    return $res;
}

sub friendof
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);
    return fail($req,502) unless LJ::get_db_reader();
    my $u = $flags->{'u'};
    my $res = {};

    # TAG:FR:protocol:getfriends_of2 (same as TAG:FR:protocol:getfriends_of)
    $res->{'friendofs'} = list_friends($u, {
        'friendof' => 1,
        'limit' => $req->{'friendoflimit'},
    });
    if ($req->{'ver'} >= 1) {
        foreach(@{$res->{'friendofs'}}) { LJ::text_out(\$_->{'fullname'}) };
    }
    return $res;
}

sub checkfriends
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);
    my $u = $flags->{'u'};
    my $res = {};

    # return immediately if they can't use this mode
    unless (LJ::get_cap($u, "checkfriends")) {
        $res->{'new'} = 0;
        $res->{'interval'} = 36000;  # tell client to bugger off
        return $res;
    }

    ## have a valid date?
    my $lastupdate = $req->{'lastupdate'};
    if ($lastupdate) {
        return fail($err,203) unless
            ($lastupdate =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
    } else {
        $lastupdate = "0000-00-00 00:00:00";
    }

    my $interval = LJ::get_cap_min($u, "checkfriends_interval");
    $res->{'interval'} = $interval;

    my $mask;
    if ($req->{'mask'} and $req->{'mask'} !~ /\D/) {
        $mask = $req->{'mask'};
    }

    my $memkey = [$u->{'userid'},"checkfriends:$u->{userid}:$mask"];
    my $update = LJ::MemCache::get($memkey);
    unless ($update) {
        # TAG:FR:protocol:checkfriends (wants reading list of mask, not "friends")
        my $fr = LJ::get_friends($u, $mask);
        unless ($fr && %$fr) {
            $res->{'new'} = 0;
            $res->{'lastupdate'} = $lastupdate;
            return $res;
        }
        if (@LJ::MEMCACHE_SERVERS) {
            my $tu = LJ::get_timeupdate_multi({ memcache_only => 1 }, keys %$fr);
            my $max = 0;
            while ($_ = each %$tu) {
                $max = $tu->{$_} if $tu->{$_} > $max;
            }
            $update = LJ::mysql_time($max) if $max;
        } else {
            my $dbr = LJ::get_db_reader();
            unless ($dbr) {
                # rather than return a 502 no-db error, just say no updates,
                # because problem'll be fixed soon enough by db admins
                $res->{'new'} = 0;
                $res->{'lastupdate'} = $lastupdate;
                return $res;
            }
            my $list = join(", ", map { int($_) } keys %$fr);
            if ($list) {
              my $sql = "SELECT MAX(timeupdate) FROM userusage ".
                  "WHERE userid IN ($list)";
              $update = $dbr->selectrow_array($sql);
            } 
        }
        LJ::MemCache::set($memkey,$update,time()+$interval) if $update;
    }
    $update ||= "0000-00-00 00:00:00";

    if ($req->{'lastupdate'} && $update gt $lastupdate) {
        $res->{'new'} = 1;
    } else {
        $res->{'new'} = 0;
    }

    $res->{'lastupdate'} = $update;
    return $res;
}

sub getdaycounts
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);
    return undef unless check_altusage($req, $err, $flags);

    my $u = $flags->{'u'};
    my $uowner = $flags->{'u_owner'} || $u;
    my $ownerid = $flags->{'ownerid'};

    my $res = {};
    my $daycts = LJ::get_daycounts($uowner, $u);
    return fail($err,502) unless $daycts;

    foreach my $day (@$daycts) {
        my $date = sprintf("%04d-%02d-%02d", $day->[0], $day->[1], $day->[2]);
        push @{$res->{'daycounts'}}, { 'date' => $date, 'count' => $day->[3] };
    }
    return $res;
}

sub common_event_validation
{
    my ($req, $err, $flags) = @_;

    # clean up event whitespace
    # remove surrounding whitespace
    $req->{event} =~ s/^\s+//;
    $req->{event} =~ s/\s+$//;

    # convert line endings to unix format
    if ($req->{'lineendings'} eq "mac") {
        $req->{event} =~ s/\r/\n/g;
    } else {
        $req->{event} =~ s/\r//g;
    }

    # date validation
    if ($req->{'year'} !~ /^\d\d\d\d$/ ||
        $req->{'year'} < 1970 ||    # before unix time started = bad
        $req->{'year'} > 2037)      # after unix time ends = worse!  :)
    {
        return fail($err,203,"Invalid year value.");
    }
    if ($req->{'mon'} !~ /^\d{1,2}$/ ||
        $req->{'mon'} < 1 ||
        $req->{'mon'} > 12)
    {
        return fail($err,203,"Invalid month value.");
    }
    if ($req->{'day'} !~ /^\d{1,2}$/ || $req->{'day'} < 1 ||
        $req->{'day'} > LJ::days_in_month($req->{'mon'},
                                          $req->{'year'}))
    {
        return fail($err,203,"Invalid day of month value.");
    }
    if ($req->{'hour'} !~ /^\d{1,2}$/ ||
        $req->{'hour'} < 0 || $req->{'hour'} > 23)
    {
        return fail($err,203,"Invalid hour value.");
    }
    if ($req->{'min'} !~ /^\d{1,2}$/ ||
        $req->{'min'} < 0 || $req->{'min'} > 59)
    {
        return fail($err,203,"Invalid minute value.");
    }

    # column width
    # we only trim Unicode data

    if ($req->{'ver'} >=1 ) {
        $req->{'subject'} = LJ::text_trim($req->{'subject'}, LJ::BMAX_SUBJECT, LJ::CMAX_SUBJECT);
        $req->{'event'} = LJ::text_trim($req->{'event'}, LJ::BMAX_EVENT, LJ::CMAX_EVENT);
        foreach (keys %{$req->{'props'}}) {
            # do not trim these properties as they're magical and handled later
            next if $_ eq 'taglist';

            $req->{'props'}->{$_} = LJ::text_trim($req->{'props'}->{$_}, LJ::BMAX_PROP, LJ::CMAX_PROP);
        }
    }

    # setup non-user meta-data.  it's important we define this here to
    # 0.  if it's not defined at all, then an editevent where a user
    # removes random 8bit data won't remove the metadata.  not that
    # that matters much.  but having this here won't hurt.  false
    # meta-data isn't saved anyway.  so the only point of this next
    # line is making the metadata be deleted on edit.
    $req->{'props'}->{'unknown8bit'} = 0;

    # we don't want attackers sending something that looks like gzipped data
    # in protocol version 0 (unknown8bit allowed), otherwise they might
    # inject a 100MB string of single letters in a few bytes.
    return fail($err,208,"Cannot send gzipped data") 
        if substr($req->{'event'},0,2) eq "\037\213";
    
    # non-ASCII?
    unless ( LJ::is_ascii($req->{'event'}) && 
        LJ::is_ascii($req->{'subject'}) &&
        LJ::is_ascii(join(' ', values %{$req->{'props'}}) ))
    {
        if ($req->{'ver'} < 1) { # client doesn't support Unicode
            # only people should have unknown8bit entries.
            my $uowner = $flags->{u_owner} || $flags->{u};
            return fail($err,207,'Posting in a community with international or special characters require a Unicode-capable LiveJournal client.  Download one at http://www.livejournal.com/download/.')
                if $uowner->{journaltype} ne 'P';

            # so rest of site can change chars to ? marks until
            # default user's encoding is set.  (legacy support)
            $req->{'props'}->{'unknown8bit'} = 1;
        } else {
            return fail($err,207, "This installation does not support Unicode clients") unless $LJ::UNICODE;
            # validate that the text is valid UTF-8
            if (!LJ::text_in($req->{'subject'}) ||
                !LJ::text_in($req->{'event'}) ||
                grep { !LJ::text_in($_) } values %{$req->{'props'}}) {
                return fail($err, 208, "The text entered is not a valid UTF-8 stream");
            }
        }
    }

    ## handle meta-data (properties)
    LJ::load_props("log");
    foreach my $pname (keys %{$req->{'props'}})
    {
        my $p = LJ::get_prop("log", $pname);

        # does the property even exist?
        unless ($p) {
            $pname =~ s/[^\w]//g;
            return fail($err,205,$pname);
        }

        # don't validate its type if it's 0 or undef (deleting)
        next unless ($req->{'props'}->{$pname});

        my $ptype = $p->{'datatype'};
        my $val = $req->{'props'}->{$pname};

        if ($ptype eq "bool" && $val !~ /^[01]$/) {
            return fail($err,204,"Property \"$pname\" should be 0 or 1");
        }
        if ($ptype eq "num" && $val =~ /[^\d]/) {
            return fail($err,204,"Property \"$pname\" should be numeric");
        }
    }

    # check props for inactive userpic
    if (my $pickwd = $req->{'props'}->{'picture_keyword'}) {
        my $pic = LJ::get_pic_from_keyword($flags->{'u'}, $pickwd);

        # need to make sure they aren't trying to post with an inactive keyword, but also
        # we don't want to allow them to post with a keyword that has no pic at all to prevent
        # them from deleting the keyword, posting, then adding it back with editpics.bml
        delete $req->{'props'}->{'picture_keyword'} if ! $pic || $pic->{'state'} eq 'I';
    }

    # validate incoming list of tags
    return fail($err, 211)
        if $req->{props}->{taglist} &&
           ! LJ::Tags::is_valid_tagstring($req->{props}->{taglist});

    return 1;
}

sub postevent
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);
    return undef unless check_altusage($req, $err, $flags);

    my $u = $flags->{'u'};
    my $ownerid = $flags->{'ownerid'}+0;
    my $uowner = $flags->{'u_owner'} || $u;
    # Make sure we have a real user object here
    $uowner = LJ::want_user($uowner) unless LJ::isu($uowner);
    my $clusterid = $uowner->{'clusterid'};

    my $dbh = LJ::get_db_writer();
    my $dbcm = LJ::get_cluster_master($uowner);

    return fail($err,306) unless $dbh && $dbcm && $uowner->writer;
    return fail($err,200) unless $req->{'event'} =~ /\S/;

    ### make sure community, shared, or news journals don't post
    ### note: shared and news journals are deprecated.  every shared journal
    ##        should one day be a community journal, of some form.
    return fail($err,150) if ($u->{'journaltype'} eq "C" ||
                              $u->{'journaltype'} eq "S" ||
                              $u->{'journaltype'} eq "I" ||
                              $u->{'journaltype'} eq "N");

    # underage users can't do this
    return fail($err,310) if $u->underage;

    # suspended users can't post
    return fail($err,305) if ($u->{'statusvis'} eq "S");

    # memorials can't post
    return fail($err,309) if $u->{statusvis} eq 'M';

    # locked accounts can't post
    return fail($err,308) if $u->{statusvis} eq 'L';
    
    # check the journal's read-only bit
    return fail($err,306) if LJ::get_cap($uowner, "readonly");

    # is the user allowed to post?
    return fail($err,404,$LJ::MSG_NO_POST) unless LJ::get_cap($u, "can_post");

    # is the user allowed to post?
    return fail($err,410) if LJ::get_cap($u, "disable_can_post");

    # can't post to deleted/suspended community
    return fail($err,307) unless $uowner->{'statusvis'} eq "V";

    # must have a validated email address to post to a community
    return fail($err, 155, "You must have an authenticated email address in order to post to another account")
        unless LJ::u_equals($u, $uowner) || $u->{'status'} eq 'A';

    # post content too large
    # NOTE: requires $req->{event} be binary data, but we've already
    # removed the utf-8 flag in the XML-RPC path, and it never gets
    # set in the "flat" protocol path.
    return fail($err,409) if length($req->{'event'}) >= LJ::BMAX_EVENT;

    my $time_was_faked = 0;
    my $offset = 0;  # assume gmt at first.

    if (defined $req->{'tz'}) {
        if ($req->{tz} eq 'guess') {
            LJ::get_timezone($uowner, \$offset, \$time_was_faked);
        } elsif ($req->{'tz'} =~ /^[+\-]\d\d\d\d$/) {
            # FIXME we ought to store this timezone and make use of it somehow.
            $offset = $req->{'tz'} / 100.0;
        } else {
            return fail($err, 203, "Invalid tz");
        }
    }

    if (defined $req->{'tz'} and not grep { defined $req->{$_} } qw(year mon day hour min)) {
        my @ltime = gmtime(time() + ($offset*3600));
        $req->{'year'} = $ltime[5]+1900;
        $req->{'mon'}  = $ltime[4]+1;
        $req->{'day'}  = $ltime[3];
        $req->{'hour'} = $ltime[2];
        $req->{'min'}  = $ltime[1];
    }

    return undef
        unless common_event_validation($req, $err, $flags);

    # confirm we can add tags, at least
    return fail($err, 312)
        if $req->{props} && $req->{props}->{taglist} &&
           ! LJ::Tags::can_add_tags($uowner, $u);

    my $event = $req->{'event'};

    ### allow for posting to journals that aren't yours (if you have permission)
    my $posterid = $u->{'userid'}+0;

    # make the proper date format
    my $eventtime = sprintf("%04d-%02d-%02d %02d:%02d",
                                $req->{'year'}, $req->{'mon'},
                                $req->{'day'}, $req->{'hour'},
                                $req->{'min'});
    my $qeventtime = $dbh->quote($eventtime);

    # load userprops all at once
    my @poster_props = qw(newesteventtime dupsig_post);
    my @owner_props = qw(newpost_minsecurity moderated);
    push @owner_props, 'opt_weblogscom' unless $req->{'props'}->{'opt_backdated'};

    LJ::load_user_props($u, @poster_props, @owner_props);
    if ($uowner->{'userid'} == $u->{'userid'}) {
        $uowner->{$_} = $u->{$_} foreach (@owner_props);
    } else {
        LJ::load_user_props($uowner, @owner_props);
    }

    # are they trying to post back in time?
    if ($posterid == $ownerid && !$time_was_faked && 
        $u->{'newesteventtime'} && $eventtime lt $u->{'newesteventtime'} &&
        !$req->{'props'}->{'opt_backdated'}) {
        return fail($err, 153, "Your most recent journal entry is dated $u->{'newesteventtime'}, but you're trying to post one at $eventtime without the backdate option turned on.  Please check your computer's clock.  Or, if you really mean to post in the past, use the backdate option.");
    }

    my $qallowmask = $req->{'allowmask'}+0;
    my $security = "public";
    my $uselogsec = 0;
    if ($req->{'security'} eq "usemask" || $req->{'security'} eq "private") {
        $security = $req->{'security'};
    }
    if ($req->{'security'} eq "usemask") {
        $uselogsec = 1;
    }

    ## if newpost_minsecurity is set, new entries have to be 
    ## a minimum security level
    $security = "private" 
        if $uowner->{'newpost_minsecurity'} eq "private";
    ($security, $qallowmask) = ("usemask", 1)
        if $uowner->{'newpost_minsecurity'} eq "friends" 
        and $security eq "public";

    my $qsecurity = $dbh->quote($security);
    
    ### make sure user can't post with "custom/private security" on shared journals
    return fail($err,102)
        if ($ownerid != $posterid && # community post
            ($req->{'security'} eq "private" ||
            ($req->{'security'} eq "usemask" && $qallowmask != 1 )));

    # make sure this user isn't banned from posting here (if
    # this is a community journal)
    return fail($err,151) if
        LJ::is_banned($posterid, $ownerid);

    # don't allow backdated posts in communities
    return fail($err,152) if
        ($req->{'props'}->{"opt_backdated"} &&
         $uowner->{'journaltype'} ne "P");

    # do processing of embedded polls (doesn't add to database, just
    # does validity checking)
    my @polls = ();
    if (LJ::Poll::contains_new_poll(\$event))
    {
        return fail($err,301,"Your account type doesn't permit creating polls.")
            unless (LJ::get_cap($u, "makepoll")
                    || ($uowner->{'journaltype'} eq "C"
                        && LJ::get_cap($uowner, "makepoll")
                        && LJ::can_manage_other($u, $uowner)));

        my $error = "";
        @polls = LJ::Poll::parse(\$event, \$error, {
            'journalid' => $ownerid,
            'posterid' => $posterid,
        });
        return fail($err,103,$error) if $error;
    }

    my $now = $dbcm->selectrow_array("SELECT UNIX_TIMESTAMP()");
    my $anum  = int(rand(256));
    
    # by default we record the true reverse time that the item was entered.
    # however, if backdate is on, we put the reverse time at the end of time
    # (which makes it equivalent to 1969, but get_recent_items will never load
    # it... where clause there is: < $LJ::EndOfTime).  but this way we can
    # have entries that don't show up on friends view, now that we don't have
    # the hints table to not insert into.
    my $rlogtime = $LJ::EndOfTime;
    unless ($req->{'props'}->{"opt_backdated"}) {
        $rlogtime -= $now;
    }

    my $dupsig = Digest::MD5::md5_hex(join('', map { $req->{$_} } 
                                           qw(subject event usejournal security allowmask)));
    my $lock_key = "post-$ownerid";

    # release our duplicate lock
    my $release = sub {  $dbcm->do("SELECT RELEASE_LOCK(?)", undef, $lock_key); };

    # our own local version of fail that releases our lock first
    my $fail = sub { $release->(); return fail(@_); };

    my $res = {};
    my $res_done = 0;  # set true by getlock when post was duplicate, or error getting lock

    my $getlock = sub {
        my $r = $dbcm->selectrow_array("SELECT GET_LOCK(?, 2)", undef, $lock_key);
        unless ($r) {
            $res = undef;    # a failure case has an undef result
            fail($err,503);  # set error flag to "can't get lock";
            $res_done = 1;   # tell caller to bail out
            return;
        }
        my @parts = split(/:/, $u->{'dupsig_post'});
        if ($parts[0] eq $dupsig) {
            # duplicate!  let's make the client think this was just the
            # normal first response.
            $res->{'itemid'} = $parts[1];
            $res->{'anum'} = $parts[2];
            $res_done = 1;
            $release->();
        }
    };

    # if posting to a moderated community, store and bail out here
    if ($uowner->{'journaltype'} eq 'C' && $uowner->{'moderated'} && !$flags->{'nomod'}) {
        # don't moderate admins, moderators & pre-approved users
        my $dbh = LJ::get_db_writer();
        my $relcount = $dbh->selectrow_array("SELECT COUNT(*) FROM reluser ".
                                             "WHERE userid=$ownerid AND targetid=$posterid ".
                                             "AND type IN ('A','M','N')");
        unless ($relcount) {
            # moderation queue full?
            my $modcount = $dbcm->selectrow_array("SELECT COUNT(*) FROM modlog WHERE journalid=$ownerid");
            return fail($err, 407) if $modcount >= LJ::get_cap($uowner, "mod_queue");

            $modcount = $dbcm->selectrow_array("SELECT COUNT(*) FROM modlog ".
                                               "WHERE journalid=$ownerid AND posterid=$posterid");
            return fail($err, 408) if $modcount >= LJ::get_cap($uowner, "mod_queue_per_poster");

            $req->{'_moderate'}->{'authcode'} = LJ::make_auth_code(15);
            my $fr = $dbcm->quote(Storable::freeze($req));
            return fail($err, 409) if length($fr) > 200_000;

            # store
            my $modid = LJ::alloc_user_counter($uowner, "M");
            return fail($err, 501) unless $modid;

            $uowner->do("INSERT INTO modlog (journalid, modid, posterid, subject, logtime) ".
                        "VALUES ($ownerid, $modid, $posterid, ?, NOW())", undef,
                        LJ::text_trim($req->{'subject'}, 30, 0));
            return fail($err, 501) if $uowner->err;

            $uowner->do("INSERT INTO modblob (journalid, modid, request_stor) ".
                        "VALUES ($ownerid, $modid, $fr)");
            if ($uowner->err) {
                $uowner->do("DELETE FROM modlog WHERE journalid=$ownerid AND modid=$modid");
                return fail($err, 501);
            }

            # alert moderator(s)
            my $mods = LJ::load_rel_user($dbh, $ownerid, 'M') || [];
            if (@$mods) {
                # load up all these mods and figure out if they want email or not
                my $modlist = LJ::load_userids(@$mods);
                my @mailtomods;
                foreach my $mod (values %$modlist) {
                    LJ::load_user_props($mod, 'opt_nomodemail');
                    push @mailtomods, $mod->{userid}
                        unless $mod->{opt_nomodemail};
                }

                # now get the email addresses of people who want email
                if (@mailtomods) {
                    my $in = join(", ", map { $_+0 } @mailtomods );
                    my $emails = $dbh->selectcol_arrayref("SELECT email FROM user USE INDEX (PRIMARY) ".
                                                          "WHERE userid IN ($in) AND status='A'") || [];
                    my $ct;
                    foreach my $to (@$emails) {
                        last if ++$ct > 20;  # don't send more than 20 emails.
                        my $body = ("There has been a new submission into the community '$uowner->{'user'}'\n".
                                    "which you moderate.\n\n".
                                    "      User: $u->{'user'}\n".
                                    "   Subject: $req->{'subject'}\n\n".
                                    "To accept or reject the submission, please go to this address:\n\n" .
                                    "   $LJ::SITEROOT/community/moderate.bml?comm=$uowner->{'user'}\n\n".
                                    "Regards,\n$LJ::SITENAME Team\n\n$LJ::SITEROOT/\n");
                        LJ::send_mail({
                            'to' => $to, 
                            'from' => $LJ::ADMIN_EMAIL,
                            'charset' => 'utf-8',
                            'subject' => "Moderated submission notification",
                            'body' => $body,
                        });
                    }
                }
            }

            my $msg = translate($u, "modpost", undef);
            return { 'message' => $msg };
        }
    } # /moderated comms

    # posting:

    $getlock->(); return $res if $res_done;
    
    # do rate-checking
    if ($u->{'journaltype'} ne "Y" && ! LJ::rate_log($u, "post", 1)) {
        return $fail->($err,405);
    }
    
    my $jitemid = LJ::alloc_user_counter($uowner, "L");
    return $fail->($err,501,"No itemid could be generated.") unless $jitemid;

    LJ::replycount_do($uowner, $jitemid, "init");

    # remove comments and logprops on new entry ... see comment by this sub for clarification
    LJ::Protocol::new_entry_cleanup_hack($u, $jitemid) if $LJ::NEW_ENTRY_CLEANUP_HACK;
    my $verb = $LJ::NEW_ENTRY_CLEANUP_HACK ? 'REPLACE' : 'INSERT';

    my $dberr;
    $uowner->log2_do(\$dberr, "INSERT INTO log2 (journalid, jitemid, posterid, eventtime, logtime, security, ".
                     "allowmask, replycount, year, month, day, revttime, rlogtime, anum) ".
                     "VALUES ($ownerid, $jitemid, $posterid, $qeventtime, FROM_UNIXTIME($now), $qsecurity, $qallowmask, ".
                     "0, $req->{'year'}, $req->{'mon'}, $req->{'day'}, $LJ::EndOfTime-".
                     "UNIX_TIMESTAMP($qeventtime), $rlogtime, $anum)");
    return $fail->($err,501,$dberr) if $dberr;

    LJ::MemCache::incr([$ownerid, "log2ct:$ownerid"]);
    LJ::memcache_kill($ownerid, "dayct");

    # set userprops.
    {
        my %set_userprop;
        
        # keep track of itemid/anum for later potential duplicates
        $set_userprop{"dupsig_post"} = "$dupsig:$jitemid:$anum";

        # record the eventtime of the last update (for own journals only)
        $set_userprop{"newesteventtime"} = $eventtime
            if $posterid == $ownerid and not $req->{'props'}->{'opt_backdated'} and not $time_was_faked;

        LJ::set_userprop($u, \%set_userprop);
    }

    # end duplicate locking section
    $release->();

    my $ditemid = $jitemid * 256 + $anum;

    ### finish embedding stuff now that we have the itemid
    {
        ### this should NOT return an error, and we're mildly fucked by now
        ### if it does (would have to delete the log row up there), so we're
        ### not going to check it for now.

        my $error = "";
        LJ::Poll::register(\$event, \$error, $ditemid, @polls);
    }
    #### /embedding

    ### extract links for meme tracking
    unless ($req->{'security'} eq "usemask" ||
            $req->{'security'} eq "private")
    {
        foreach my $url (LJ::get_urls($event)) {
            LJ::record_meme($url, $posterid, $ditemid, $ownerid);
        }
    }

    # record journal's disk usage
    my $bytes = length($event) + length($req->{'subject'});
    $uowner->dudata_set('L', $jitemid, $bytes);

    $uowner->do("$verb INTO logtext2 (journalid, jitemid, subject, event) ".
                "VALUES ($ownerid, $jitemid, ?, ?)", undef, $req->{'subject'}, 
                LJ::text_compress($event));
    if ($uowner->err) {
        my $msg = $uowner->errstr;
        LJ::delete_entry($uowner, $jitemid);   # roll-back
        return fail($err,501,"logtext:$msg");
    }
    LJ::MemCache::set([$ownerid,"logtext:$clusterid:$ownerid:$jitemid"],
                      [ $req->{'subject'}, $event ]);

    # keep track of custom security stuff in other table.
    if ($uselogsec) {
        $uowner->do("INSERT INTO logsec2 (journalid, jitemid, allowmask) ".
                    "VALUES ($ownerid, $jitemid, $qallowmask)");
        if ($uowner->err) {
            my $msg = $uowner->errstr;
            LJ::delete_entry($uowner, $jitemid);   # roll-back
            return fail($err,501,"logsec2:$msg");
        }
    }

    # construct valid prop list
    if ($req->{props} && $req->{props}->{taglist}) {
        my $tags = [];
        LJ::Tags::is_valid_tagstring($req->{props}->{taglist}, $tags);
        $req->{props}->{taglist} = join(', ', @$tags);

        # handle tags if they're defined
        LJ::Tags::update_logtags($uowner, $jitemid, {
                set_string => $req->{props}->{taglist},
                remote => $u,
            });
    }

    # meta-data
    if (%{$req->{'props'}}) {
        my $propset = {};
        foreach my $pname (keys %{$req->{'props'}}) {
            next unless $req->{'props'}->{$pname};
            next if $pname eq "revnum" || $pname eq "revtime";
            my $p = LJ::get_prop("log", $pname);
            next unless $p;
            next unless $req->{'props'}->{$pname};
            $propset->{$pname} = $req->{'props'}->{$pname};
        }
        my %logprops;
        LJ::set_logprop($uowner, $jitemid, $propset, \%logprops) if %$propset;

        # if set_logprop modified props above, we can set the memcache key
        # to be the hashref of modified props, since this is a new post
        LJ::MemCache::set([$uowner->{'userid'}, "logprop:$uowner->{'userid'}:$jitemid"],
                          \%logprops) if %logprops;
    }

    $dbh->do("UPDATE userusage SET timeupdate=NOW(), lastitemid=$jitemid ".
             "WHERE userid=$ownerid");
    LJ::MemCache::set([$ownerid, "tu:$ownerid"], pack("N", time()), 30*60);

    # note this post in recentactions table
    LJ::note_recent_action($uowner, 'post');

    # update user update table (on which friends views rely)
    # NOTE: as of Mar-25-2003, we don't actually use this yet.  we might
    # use it in the future though, for faster ?skip=0 friends views.
    # for now, we'll keep it disabled to lessen writes
    if (0) {
        my @bits;
        if ($security eq "public") {
            push @bits, 31;  # 31 means public
        } elsif ($security eq "private") {
            push @bits, 32;  # 1<<32 doesn't exist (too big), but we'll use it in this table
        } else {
            for (my $i=0; $i<=30; $i++) {
                next unless $qallowmask & (1<<$i);
                push @bits, $i;
            }
        }
        if (@bits) {
            $dbh->do("REPLACE INTO userupdate (userid, groupbit, timeupdate) VALUES ".
                     join(",", map { "($ownerid, $_, NOW())" } @bits));
        }
    }

    # notify weblogs.com of post if necessary
    if ($u->{'opt_weblogscom'} && LJ::get_cap($u, "weblogscom") &&
        $security eq "public" && ! $req->{'props'}->{'opt_backdated'})
    {
        LJ::cmd_buffer_add($uowner->{clusterid}, $u->{'userid'}, 'weblogscom', {
            'user' => $u->{'user'}, 
            'title' => $u->{'journaltitle'} || $u->{'name'},
            'url' => LJ::journal_base($u) . "/",
        });
      }

    # run local site-specific actions
    LJ::run_hooks("postpost", {
        'itemid' => $jitemid,
        'anum' => $anum,
        'journal' => $uowner,
        'poster' => $u,
        'event' => $event,
        'subject' => $req->{'subject'},
        'security' => $security,
        'allowmask' => $qallowmask,
        'props' => $req->{'props'},
    });

    # cluster tracking
    LJ::mark_user_active($u, 'post');
    LJ::mark_user_active($uowner, 'post') unless LJ::u_equals($u, $uowner);

    $res->{'itemid'} = $jitemid;  # by request of mart
    $res->{'anum'} = $anum;
    $res->{'url'} = LJ::item_link($uowner, $jitemid, $anum);
    return $res;
}

sub editevent
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);

    # we check later that user owns entry they're modifying, so all
    # we care about for check_altusage is that the target journal
    # exists, and we want it to setup some data in $flags.
    $flags->{'ignorecanuse'} = 1;
    return undef unless check_altusage($req, $err, $flags);

    my $u = $flags->{'u'};
    my $ownerid = $flags->{'ownerid'};
    my $uowner = $flags->{'u_owner'} || $u;
    # Make sure we have a user object here
    $uowner = LJ::want_user($uowner) unless LJ::isu($uowner);
    my $clusterid = $uowner->{'clusterid'};
    my $posterid = $u->{'userid'};
    my $qallowmask = $req->{'allowmask'}+0;
    my $sth;

    my $itemid = $req->{'itemid'}+0;

    # underage users can't do this
    return fail($err,310) if $u->underage;

    # check the journal's read-only bit
    return fail($err,306) if LJ::get_cap($uowner, "readonly");

    # can't edit in deleted/suspended community
    return fail($err,307) unless $uowner->{'statusvis'} eq "V";

    my $dbcm = LJ::get_cluster_master($uowner);
    return fail($err,306) unless $dbcm;

    ### make sure user can't change a post to "custom/private security" on shared journals
    return fail($err,102)
        if ($ownerid != $posterid && # community post
            ($req->{'security'} eq "private" ||
            ($req->{'security'} eq "usemask" && $qallowmask != 1 )));

    # fetch the old entry from master database so we know what we
    # really have to update later.  usually people just edit one part,
    # not every field in every table.  reads are quicker than writes,
    # so this is worth it.
    my $oldevent = $dbcm->selectrow_hashref
	("SELECT journalid AS 'ownerid', posterid, eventtime, logtime, ".
	 "compressed, security, allowmask, year, month, day, ".
	 "rlogtime, anum FROM log2 WHERE journalid=$ownerid AND jitemid=$itemid");

    ($oldevent->{event}, $oldevent->{subject}) = $dbcm->selectrow_array
        ("SELECT subject, event FROM logtext2 ".
         "WHERE journalid=$ownerid AND jitemid=$itemid");

    LJ::text_uncompress(\$oldevent->{'event'});

    # kill seconds in eventtime, since we don't use it, then we can use 'eq' and such
    $oldevent->{'eventtime'} =~ s/:00$//;

    ### make sure this user is allowed to edit this entry
    return fail($err,302)
        unless ($ownerid == $oldevent->{'ownerid'});

    ### what can they do to somebody elses entry?  (in shared journal)
    if ($posterid != $oldevent->{'posterid'})
    {
        ## deleting.
        return fail($err,304)
            if ($req->{'event'} !~ /\S/ && !
                ($ownerid == $u->{'userid'} ||
                 # community account can delete it (ick)

                 LJ::can_manage_other($posterid, $ownerid)
                 # if user is a community maintainer they can delete
                 # it too (good)
                 ));

        ## editing:
        return fail($err,303)
            if ($req->{'event'} =~ /\S/);
    }

    # simple logic for deleting an entry
    if ($req->{'event'} !~ /\S/)
    {
        # if their newesteventtime prop equals the time of the one they're deleting
        # then delete their newesteventtime.
        if ($u->{'userid'} == $uowner->{'userid'}) {
            LJ::load_user_props($u, { use_master => 1 }, "newesteventtime");
            if ($u->{'newesteventtime'} eq $oldevent->{'eventtime'}) {
                LJ::set_userprop($u, "newesteventtime", undef);
            }
        }

        # log this event, unless noauth is on, which means it is being done internally and we should
        # rely on them to log why they're deleting the entry if they need to.  that way we don't have
        # double entries, and we have as much information available as possible at the location the
        # delete is initiated.
        $uowner->log_event('delete_entry', {
                remote => $u,
                actiontarget => ($req->{itemid} * 256 + $oldevent->{anum}),
                method => 'protocol',
            })
            unless $flags->{noauth};

        LJ::delete_entry($uowner, $req->{'itemid'}, 'quick', $oldevent->{'anum'});

        # clear their duplicate protection, so they can later repost
        # what they just deleted.  (or something... probably rare.)
        LJ::set_userprop($u, "dupsig_post", undef);
        
        my $res = { 'itemid' => $itemid,
                    'anum' => $oldevent->{'anum'} };
        return $res;
    }

    # now make sure the new entry text isn't $CannotBeShown
    return fail($err, 210)
        if $req->{event} eq $CannotBeShown;

    # don't allow backdated posts in communities
    return fail($err,152) if
        ($req->{'props'}->{"opt_backdated"} &&
         $uowner->{'journaltype'} ne "P");

    # make year/mon/day/hour/min optional in an edit event,
    # and just inherit their old values
    {
        $oldevent->{'eventtime'} =~ /^(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d)/;
        $req->{'year'} = $1 unless defined $req->{'year'};
        $req->{'mon'} = $2+0 unless defined $req->{'mon'};
        $req->{'day'} = $3+0 unless defined $req->{'day'};
        $req->{'hour'} = $4+0 unless defined $req->{'hour'};
        $req->{'min'} = $5+0 unless defined $req->{'min'};
    }

    # updating an entry:
    return undef
        unless common_event_validation($req, $err, $flags);

    ### load existing meta-data
    my %curprops;

    LJ::load_log_props2($dbcm, $ownerid, [ $itemid ], \%curprops);

    ## handle meta-data (properties)
    my %props_byname = ();
    foreach my $key (keys %{$req->{'props'}}) {
        ## changing to something else?
        if ($curprops{$itemid}->{$key} ne $req->{'props'}->{$key}) {
            $props_byname{$key} = $req->{'props'}->{$key};
        }
    }

    my $event = $req->{'event'};
    my $bytes = length($event) + length($req->{'subject'});

    my $eventtime = sprintf("%04d-%02d-%02d %02d:%02d",
                            map { $req->{$_} } qw(year mon day hour min));
    my $qeventtime = $dbcm->quote($eventtime);

    # preserve old security by default, use user supplied if it's understood
    my $security = $oldevent->{security};
    $security = $req->{security}
        if $req->{security} &&
           $req->{security} =~ /^(?:public|private|usemask)$/;

    my $do_tags = $req->{props} && $req->{props}->{taglist};
    if ($oldevent->{security} ne $security || $qallowmask != $oldevent->{allowmask}) {
        # FIXME: this is a hopefully temporary hack which deletes tags from the entry
        # when the security has changed.  the real fix is to make update_logtags aware
        # of security changes so it can update logkwsum appropriately.

        unless ($do_tags) {
            # we need to fix security on this entry's tags, but the user didn't give us a tag list
            # to work with, so we have to go get the tags on the entry, and construct a tag list,
            # in order to pass to update_logtags down at the bottom of this whole update
            my $tags = LJ::Tags::get_logtags($uowner, $itemid);
            $tags = $tags->{"$uowner->{userid} $itemid"};
            $req->{props}->{taglist} = join(',', sort map { $_->{name} } values %{$tags || {}});
            $do_tags = 1; # bleh, force the update later
        }

        LJ::Tags::delete_logtags($uowner, $itemid);
    }

    my $qyear = $req->{'year'}+0;
    my $qmonth = $req->{'mon'}+0;
    my $qday = $req->{'day'}+0;

    if ($eventtime ne $oldevent->{'eventtime'} ||
        $security ne $oldevent->{'security'} ||
        (!$curprops{opt_backdated} && $req->{props}{opt_backdated}) ||
        $qallowmask != $oldevent->{'allowmask'})
    {
        # are they changing their most recent post?
        LJ::load_user_props($u, "newesteventtime");
        if ($u->{userid} == $uowner->{userid} &&
            $u->{newesteventtime} eq $oldevent->{eventtime}) {
            # did they change the time?
            if ($eventtime ne $oldevent->{eventtime}) {
                # the newesteventtime is this event's new time.
                LJ::set_userprop($u, "newesteventtime", $eventtime);
            } elsif (!$curprops{opt_backdated} && $req->{props}{opt_backdated}) {
                # otherwise, if they set the backdated flag,
                # then we no longer know the newesteventtime.
                LJ::set_userprop($u, "newesteventtime", undef);
            } 
        }
        
        my $qsecurity = $uowner->quote($security);
        my $dberr;
        $uowner->log2_do(\$dberr, "UPDATE log2 SET eventtime=$qeventtime, revttime=$LJ::EndOfTime-".
                         "UNIX_TIMESTAMP($qeventtime), year=$qyear, month=$qmonth, day=$qday, ".
                         "security=$qsecurity, allowmask=$qallowmask WHERE journalid=$ownerid ".
                         "AND jitemid=$itemid");
        return fail($err,501,$dberr) if $dberr;

        # update memcached
        my $sec = $qallowmask;
        $sec = 0 if $security eq 'private';
        $sec = 2**31 if $security eq 'public';

        my $row = pack("NNNNN", $oldevent->{'posterid'},
                       LJ::mysqldate_to_time($eventtime, 1),
                       LJ::mysqldate_to_time($oldevent->{'logtime'}, 1),
                       $sec,
                       $itemid*256 + $oldevent->{'anum'});

        LJ::MemCache::set([$ownerid, "log2:$ownerid:$itemid"], $row);

    }

    if ($security ne $oldevent->{'security'} ||
        $qallowmask != $oldevent->{'allowmask'})
    {
        if ($security eq "public" || $security eq "private") {
            $uowner->do("DELETE FROM logsec2 WHERE journalid=$ownerid AND jitemid=$itemid");
        } else {
            $uowner->do("REPLACE INTO logsec2 (journalid, jitemid, allowmask) ".
                        "VALUES ($ownerid, $itemid, $qallowmask)");
        }
        return fail($err,501,$dbcm->errstr) if $uowner->err;
    }

    LJ::MemCache::set([$ownerid,"logtext:$clusterid:$ownerid:$itemid"],
                      [ $req->{'subject'}, $event ]);

    if ($event ne $oldevent->{'event'} ||
        $req->{'subject'} ne $oldevent->{'subject'})
    {
        $uowner->do("UPDATE logtext2 SET subject=?, event=? ".
                    "WHERE journalid=$ownerid AND jitemid=$itemid", undef,
                    $req->{'subject'}, LJ::text_compress($event));
        return fail($err,501,$uowner->errstr) if $uowner->err;

        # update disk usage
        $uowner->dudata_set('L', $itemid, $bytes);
    }

    # up the revision number
    $req->{'props'}->{'revnum'} = ($curprops{$itemid}->{'revnum'} || 0) + 1;
    $req->{'props'}->{'revtime'} = time();

    # handle tags if they're defined
    LJ::Tags::update_logtags($uowner, $itemid, {
            set_string => $req->{props}->{taglist},
            remote => $u,
        })
        if $do_tags;

    # handle the props
    {
        my $propset = {};
        foreach my $pname (keys %{$req->{'props'}}) {
            my $p = LJ::get_prop("log", $pname);
            next unless $p;
            $propset->{$pname} = $req->{'props'}->{$pname};
        }
        LJ::set_logprop($uowner, $itemid, $propset);
    }

    # deal with backdated changes.  if the entry's rlogtime is
    # $EndOfTime, then it's backdated.  if they want that off, need to
    # reset rlogtime to real reverse log time.  also need to set
    # rlogtime to $EndOfTime if they're turning backdate on.
    if ($req->{'props'}->{'opt_backdated'} eq "1" &&
        $oldevent->{'rlogtime'} != $LJ::EndOfTime) {
        my $dberr;
        $uowner->log2_do(undef, "UPDATE log2 SET rlogtime=$LJ::EndOfTime WHERE ".
                         "journalid=$ownerid AND jitemid=$itemid");
        return fail($err,501,$dberr) if $dberr;
    }
    if ($req->{'props'}->{'opt_backdated'} eq "0" &&
        $oldevent->{'rlogtime'} == $LJ::EndOfTime) {
        my $dberr;
        $uowner->log2_do(\$dberr, "UPDATE log2 SET rlogtime=$LJ::EndOfTime-UNIX_TIMESTAMP(logtime) ".
                         "WHERE journalid=$ownerid AND jitemid=$itemid");
        return fail($err,501,$dberr) if $dberr;
    }
    return fail($err,501,$dbcm->errstr) if $dbcm->err;

    LJ::memcache_kill($ownerid, "dayct");

    my $res = { 'itemid' => $itemid };
    if (defined $oldevent->{'anum'}) {
        $res->{'anum'} = $oldevent->{'anum'};
        $res->{'url'} = LJ::item_link($uowner, $itemid, $oldevent->{'anum'});
    }
    return $res;
}

sub getevents
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);
    return undef unless check_altusage($req, $err, $flags);

    my $u = $flags->{'u'};
    my $uowner = $flags->{'u_owner'} || $u;

    ### shared-journal support
    my $posterid = $u->{'userid'};
    my $ownerid = $flags->{'ownerid'};

    my $dbr = LJ::get_db_reader();
    my $sth;

    my $dbcr =  LJ::get_cluster_reader($uowner);
    return fail($err,502) unless $dbcr && $dbr;

    # can't pull events from deleted/suspended journal
    return fail($err,307) unless $uowner->{'statusvis'} eq "V";

    my $reject_code = $LJ::DISABLE_PROTOCOL{getevents};
    if (ref $reject_code eq "CODE") {
        my $r = eval { Apache->request };
        my $errmsg = $reject_code->($req, $flags, $r);
        if ($errmsg) { return fail($err, "311", $errmsg); }
    }

    # if this is on, we sort things different (logtime vs. posttime)
    # to avoid timezone issues
    my $is_community = ($uowner->{'journaltype'} eq "C" ||
                        $uowner->{'journaltype'} eq "S");

    # in some cases we'll use the master, to ensure there's no
    # replication delay.  useful cases: getting one item, use master
    # since user might have just made a typo and realizes it as they
    # post, or wants to append something they forgot, etc, etc.  in
    # other cases, slave is pretty sure to have it.
    my $use_master = 0;

    # the benefit of this mode over actually doing 'lastn/1' is
    # the $use_master usage.
    if ($req->{'selecttype'} eq "one" && $req->{'itemid'} eq "-1") {
        $req->{'selecttype'} = "lastn";
        $req->{'howmany'} = 1;
        undef $req->{'itemid'};
        $use_master = 1;  # see note above.
    }

    # build the query to get log rows.  each selecttype branch is
    # responsible for either populating the following 3 variables
    # OR just populating $sql
    my ($orderby, $where, $limit);
    my $sql;
    if ($req->{'selecttype'} eq "day")
    {
        return fail($err,203)
            unless ($req->{'year'} =~ /^\d\d\d\d$/ &&
                    $req->{'month'} =~ /^\d\d?$/ &&
                    $req->{'day'} =~ /^\d\d?$/ &&
                    $req->{'month'} >= 1 && $req->{'month'} <= 12 &&
                    $req->{'day'} >= 1 && $req->{'day'} <= 31);

        my $qyear = $dbr->quote($req->{'year'});
        my $qmonth = $dbr->quote($req->{'month'});
        my $qday = $dbr->quote($req->{'day'});
        $where = "AND year=$qyear AND month=$qmonth AND day=$qday";
        $limit = "LIMIT 200";  # FIXME: unhardcode this constant (also in ljviews.pl)

        # see note above about why the sort order is different
        $orderby = $is_community ? "ORDER BY logtime" : "ORDER BY eventtime";
    }
    elsif ($req->{'selecttype'} eq "lastn")
    {
        my $howmany = $req->{'howmany'} || 20;
        if ($howmany > 50) { $howmany = 50; }
        $howmany = $howmany + 0;
        $limit = "LIMIT $howmany";

        # okay, follow me here... see how we add the revttime predicate
        # even if no beforedate key is present?  you're probably saying,
        # that's retarded -- you're saying: "revttime > 0", that's like
        # saying, "if entry occurred at all."  yes yes, but that hints
        # mysql's braindead optimizer to use the right index.
        my $rtime_after = 0;
        my $rtime_what = $is_community ? "rlogtime" : "revttime";
        if ($req->{'beforedate'}) {
            return fail($err,203,"Invalid beforedate format.")
                unless ($req->{'beforedate'} =~
                        /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d$/);
            my $qd = $dbr->quote($req->{'beforedate'});
            $rtime_after = "$LJ::EndOfTime-UNIX_TIMESTAMP($qd)";
        }
        $where .= "AND $rtime_what > $rtime_after ";
        $orderby = "ORDER BY $rtime_what";
    }
    elsif ($req->{'selecttype'} eq "one")
    {
        my $id = $req->{'itemid'} + 0;
        $where = "AND jitemid=$id";
    }
    elsif ($req->{'selecttype'} eq "syncitems")
    {
        return fail($err,506) if $LJ::DISABLED{'syncitems'};
        my $date = $req->{'lastsync'} || "0000-00-00 00:00:00";
        return fail($err,203,"Invalid syncitems date format")
            unless ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);

        my $now = time();
        # broken client loop prevention
        if ($req->{'lastsync'}) {
            my $pname = "rl_syncitems_getevents_loop";
            LJ::load_user_props($u, $pname);
            # format is:  time/date/time/date/time/date/... so split
            # it into a hash, then delete pairs that are older than an hour
            my %reqs = split(m!/!, $u->{$pname});
            foreach (grep { $_ < $now - 60*60 } keys %reqs) { delete $reqs{$_}; }
            my $count = grep { $_ eq $date } values %reqs;
            $reqs{$now} = $date;
            if ($count >= 2) {
                # 2 prior, plus this one = 3 repeated requests for same synctime.
                # their client is busted.  (doesn't understand syncitems semantics)
                return fail($err,406);
            }
            LJ::set_userprop($u, $pname, 
                             join('/', map { $_, $reqs{$_} }
                                  sort { $b <=> $a } keys %reqs));
        }
        
        my %item;
        $sth = $dbcr->prepare("SELECT jitemid, logtime FROM log2 WHERE ".
                              "journalid=? and logtime > ?");
        $sth->execute($ownerid, $date);
        while (my ($id, $dt) = $sth->fetchrow_array) {
            $item{$id} = $dt;
        }

        my $p_revtime = LJ::get_prop("log", "revtime");
        $sth = $dbcr->prepare("SELECT jitemid, FROM_UNIXTIME(value) ".
                              "FROM logprop2 WHERE journalid=? ".
                              "AND propid=$p_revtime->{'id'} ".
                              "AND value+0 > UNIX_TIMESTAMP(?)");
        $sth->execute($ownerid, $date);
        while (my ($id, $dt) = $sth->fetchrow_array) {
            $item{$id} = $dt;
        }

        my $limit = 100;
        my @ids = sort { $item{$a} cmp $item{$b} } keys %item;
        if (@ids > $limit) { @ids = @ids[0..$limit-1]; }
        
        my $in = join(',', @ids) || "0";
        $where = "AND jitemid IN ($in)";
    }
    elsif ($req->{'selecttype'} eq "multiple")
    {
        my @ids;
        foreach my $num (split(/\s*,\s*/, $req->{'itemids'})) {
            return fail($err,203,"Non-numeric itemid") unless $num =~ /^\d+$/;
            push @ids, $num;
        }
        my $limit = 100;
        return fail($err,209,"Can't retrieve more than $limit entries at once") if @ids > $limit;
        my $in = join(',', @ids);
        $where = "AND jitemid IN ($in)";
    }
    else
    {
        return fail($err,200,"Invalid selecttype.");
    }

    # common SQL template:
    unless ($sql) {
        $sql = "SELECT jitemid, eventtime, security, allowmask, anum, posterid ".
            "FROM log2 WHERE journalid=$ownerid $where $orderby $limit";
    }

    # whatever selecttype might have wanted us to use the master db.
    $dbcr = LJ::get_cluster_def_reader($uowner) if $use_master;

    return fail($err,502) unless $dbcr;

    ## load the log rows
    ($sth = $dbcr->prepare($sql))->execute;
    return fail($err,501,$dbcr->errstr) if $dbcr->err;

    my $count = 0;
    my @itemids = ();
    my $res = {};
    my $events = $res->{'events'} = [];
    my %evt_from_itemid;

    while (my ($itemid, $eventtime, $sec, $mask, $anum, $jposterid) = $sth->fetchrow_array)
    {
        $count++;
        my $evt = {};
        $evt->{'itemid'} = $itemid;
        push @itemids, $itemid;

        $evt_from_itemid{$itemid} = $evt;

        $evt->{"eventtime"} = $eventtime;
        if ($sec ne "public") {
            $evt->{'security'} = $sec;
            $evt->{'allowmask'} = $mask if $sec eq "usemask";
        }
        $evt->{'anum'} = $anum;
        $evt->{'poster'} = LJ::get_username($dbr, $jposterid) if $jposterid != $ownerid;
        $evt->{'url'} = LJ::item_link($uowner, $itemid, $anum);
        push @$events, $evt;
    }

    # load properties. Even if the caller doesn't want them, we need
    # them in Unicode installations to recognize older 8bit non-UF-8
    # entries.
    unless ($req->{'noprops'} && !$LJ::UNICODE) 
    {
        ### do the properties now
        $count = 0;
        my %props = ();
        LJ::load_log_props2($dbcr, $ownerid, \@itemids, \%props);

        # load the tags for these entries, unless told not to
        unless ($req->{notags}) {
            # construct %idsbycluster for the multi call to get these tags
            my $tags = LJ::Tags::get_logtags($uowner, \@itemids);

            # add to props
            foreach my $itemid (@itemids) {
                next unless $tags->{$itemid};
                $props{$itemid}->{taglist} = join(', ', values %{$tags->{$itemid}});
            }
        }

        foreach my $itemid (keys %props) {
            # 'replycount' is a pseudo-prop, don't send it.
            # FIXME: this goes away after we restructure APIs and
            # replycounts cease being transferred in props
            delete $props{$itemid}->{'replycount'};

            my $evt = $evt_from_itemid{$itemid};
            $evt->{'props'} = {};
            foreach my $name (keys %{$props{$itemid}}) {
                my $value = $props{$itemid}->{$name};
                $value =~ s/\n/ /g;
                $evt->{'props'}->{$name} = $value;
            }
        }
    }

    ## load the text
    my $gt_opts = {
        'usemaster' => $use_master,
    };
    my $text = LJ::get_logtext2($uowner, $gt_opts, @itemids);

    foreach my $i (@itemids)
    {
        my $t = $text->{$i};
        my $evt = $evt_from_itemid{$i};

        # if they want subjects to be events, replace event
        # with subject when requested.
        if ($req->{'prefersubject'} && length($t->[0])) {
            $t->[1] = $t->[0];  # event = subject
            $t->[0] = undef;    # subject = undef
        }

        # now that we have the subject, the event and the props, 
        # auto-translate them to UTF-8 if they're not in UTF-8.
        if ($LJ::UNICODE && $req->{'ver'} >= 1 && 
                $evt->{'props'}->{'unknown8bit'}) {
            my $error = 0;
            $t->[0] = LJ::text_convert($t->[0], $uowner, \$error);
            $t->[1] = LJ::text_convert($t->[1], $uowner, \$error);
            foreach (keys %{$evt->{'props'}}) {
                $evt->{'props'}->{$_} = LJ::text_convert($evt->{'props'}->{$_}, $uowner, \$error);
            }
            return fail($err,208,"Cannot display this post. Please see $LJ::SITEROOT/support/encodings.bml for more information.")
                if $error;
        }

        if ($LJ::UNICODE && $req->{'ver'} < 1 && !$evt->{'props'}->{'unknown8bit'}) {
            unless ( LJ::is_ascii($t->[0]) && 
                     LJ::is_ascii($t->[1]) &&
                     LJ::is_ascii(join(' ', values %{$evt->{'props'}}) )) {
                # we want to fail the client that wants to get this entry
                # but we make an exception for selecttype=day, in order to allow at least
                # viewing the daily summary

                if ($req->{'selecttype'} eq 'day') {
                    $t->[0] = $t->[1] = $CannotBeShown;
                } else {
                    return fail($err,207,"Cannot display/edit a Unicode post with a non-Unicode client. Please see $LJ::SITEROOT/support/encodings.bml for more information.");
                }
            }
        }

        if ($t->[0]) {
            $t->[0] =~ s/[\r\n]/ /g;
            $evt->{'subject'} = $t->[0];
        }

        # truncate
        if ($req->{'truncate'} >= 4) {
            my $original = $t->[1];
            if ($req->{'ver'} > 1) {
                $t->[1] = LJ::text_trim($t->[1], $req->{'truncate'} - 3, 0);
            } else {
                $t->[1] = LJ::text_trim($t->[1], 0, $req->{'truncate'} - 3);
            }
            # only append the elipsis if the text was actually truncated
            $t->[1] .= "..." if $t->[1] ne $original;
        }
        
        # line endings
        $t->[1] =~ s/\r//g;
        if ($req->{'lineendings'} eq "unix") {
            # do nothing.  native format.
        } elsif ($req->{'lineendings'} eq "mac") {
            $t->[1] =~ s/\n/\r/g;
        } elsif ($req->{'lineendings'} eq "space") {
            $t->[1] =~ s/\n/ /g;
        } elsif ($req->{'lineendings'} eq "dots") {
            $t->[1] =~ s/\n/ ... /g;
        } else { # "pc" -- default
            $t->[1] =~ s/\n/\r\n/g;
        }
        $evt->{'event'} = $t->[1];
    }

    # maybe we don't need the props after all
    if ($req->{'noprops'}) {
        foreach(@$events) { delete $_->{'props'}; }
    }

    return $res;
}

sub editfriends
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);

    my $u = $flags->{'u'};
    my $userid = $u->{'userid'};
    my $dbh = LJ::get_db_writer();
    my $sth;

    return fail($err,306) unless $dbh;

    # do not let locked people do this
    return fail($err, 308) if $u->{statusvis} eq 'L';

    my $res = {};

    ## first, figure out who the current friends are to save us work later
    my %curfriend;
    my $friend_count = 0;
    # TAG:FR:protocol:editfriends1
    $sth = $dbh->prepare("SELECT u.user FROM useridmap u, friends f ".
                         "WHERE u.userid=f.friendid AND f.userid=$userid");
    $sth->execute;
    while (my ($friend) = $sth->fetchrow_array) {
        $curfriend{$friend} = 1;
        $friend_count++;
    }
    $sth->finish;

    # perform the deletions
  DELETEFRIEND:
    foreach (@{$req->{'delete'}})
    {
        my $deluser = LJ::canonical_username($_);
        next DELETEFRIEND unless ($curfriend{$deluser});

        my $friendid = LJ::get_userid($deluser);
        # TAG:FR:protocol:editfriends2_del
        LJ::remove_friend($userid, $friendid);
        $friend_count--;
    }

    my $error_flag = 0;
    my $friends_added = 0;
    my $fail = sub {
        LJ::memcache_kill($userid, "friends");
        LJ::mark_dirty($userid, "friends");
        return fail($err, $_[0], $_[1]);
    };

    # only people, shared journals, and owned syn feeds can add friends
    return $fail->(104, "Journal type cannot add friends")
        unless ($u->{'journaltype'} eq 'P' ||
                $u->{'journaltype'} eq 'S' ||
                $u->{'journaltype'} eq 'I' ||
                ($u->{'journaltype'} eq "Y" && $u->{'password'}));

    # perform the adds
  ADDFRIEND:
    foreach my $fa (@{$req->{'add'}})
    {
        unless (ref $fa eq "HASH") {
            $fa = { 'username' => $fa };
        }

        my $aname = LJ::canonical_username($fa->{'username'});
        unless ($aname) {
            $error_flag = 1;
            next ADDFRIEND;
        }

        $friend_count++ unless $curfriend{$aname};

        my $maxfriends = LJ::get_cap($u, "maxfriends");
        return $fail->(104, "Exceeded $maxfriends friends limit (now: $friend_count)")
            if ($friend_count > $maxfriends);

        my $fg = $fa->{'fgcolor'} || "#000000";
        my $bg = $fa->{'bgcolor'} || "#FFFFFF";
        if ($fg !~ /^\#[0-9A-F]{6,6}$/i || $bg !~ /^\#[0-9A-F]{6,6}$/i) {
            return $fail->(203, "Invalid color values");
        }

        my $row = LJ::load_user($aname);

        # XXX - on some errors we fail out, on others we continue and try adding
        # any other users in the request. also, error message for redirect should
        # point the user to the redirected username.
        if (! $row) {
            $error_flag = 1;
        } elsif ($row->{'journaltype'} eq "R") {
            return $fail->(154);
        } elsif ($row->{'statusvis'} ne "V") {
            $error_flag = 1;
        } else {
            $friends_added++;
            my $added = { 'username' => $aname,
                          'fullname' => $row->{'name'},
                      };
            if ($req->{'ver'} >= 1) {
                LJ::text_out(\$added->{'fullname'});
            }
            push @{$res->{'added'}}, $added;

            my $qfg = LJ::color_todb($fg);
            my $qbg = LJ::color_todb($bg);

            my $friendid = $row->{'userid'};

            my $gmask = $fa->{'groupmask'};
            if (! $gmask && $curfriend{$aname}) {
                # if no group mask sent, use the existing one if this is an existing friend
                # TAG:FR:protocol:editfriends3_getmask
                my $sth = $dbh->prepare("SELECT groupmask FROM friends ".
                                        "WHERE userid=$userid AND friendid=$friendid");
                $sth->execute;
                $gmask = $sth->fetchrow_array;
            }
            # force bit 0 on.
            $gmask |= 1;

            # TAG:FR:protocol:editfriends4_addeditfriend
            $sth = $dbh->prepare("REPLACE INTO friends (userid, friendid, fgcolor, bgcolor, groupmask) ".
                                 "VALUES ($userid, $friendid, $qfg, $qbg, $gmask)");
            $sth->execute;

            unless ($dbh->err) {
                my $memkey = [$userid,"frgmask:$userid:$friendid"];
                LJ::MemCache::set($memkey, $gmask+0, time()+60*15);
                LJ::memcache_kill($friendid, 'friendofs');
            }
            return $fail->(501,$dbh->errstr) if $dbh->err;
        }
    }

    return $fail->(104) if $error_flag;

    # invalidate memcache of friends
    LJ::memcache_kill($userid, "friends");
    LJ::mark_dirty($userid, "friends");

    return $res;
}

sub editfriendgroups
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);

    my $u = $flags->{'u'};
    my $userid = $u->{'userid'};
    my ($db, $fgtable, $bmax, $cmax) = $u->{dversion} > 5 ?
                         ($u->writer, 'friendgroup2', LJ::BMAX_GRPNAME2, LJ::CMAX_GRPNAME2) :
                         (LJ::get_db_writer(), 'friendgroup', LJ::BMAX_GRPNAME, LJ::CMAX_GRPNAME);
    my $sth;

    return fail($err,306) unless $db;

    # do not let locked people do this
    return fail($err, 308) if $u->{statusvis} eq 'L';

    my $res = {};

    ## make sure tree is how we want it
    $req->{'groupmasks'} = {} unless
        (ref $req->{'groupmasks'} eq "HASH");
    $req->{'set'} = {} unless
        (ref $req->{'set'} eq "HASH");
    $req->{'delete'} = [] unless
        (ref $req->{'delete'} eq "ARRAY");

    # Keep track of what bits are already set, so we can know later
    # whether to INSERT or UPDATE.
    my %bitset;
    my $groups = LJ::get_friend_group($userid);
    foreach my $bit (keys %{$groups || {}}) {
        $bitset{$bit} = 1;
    }

    ## before we perform any DB operations, validate input text 
    # (groups' names) for correctness so we can fail gracefully
    if ($LJ::UNICODE) {
        foreach my $bit (keys %{$req->{'set'}})
        {
            my $name = $req->{'set'}->{$bit}->{'name'};
            return fail($err,207,"non-ASCII names require a Unicode-capable client")
                if $req->{'ver'} < 1 and not LJ::is_ascii($name);
            return fail($err,208,"Invalid group names. Please see $LJ::SITEROOT/support/encodings.bml for more information.")
                unless LJ::text_in($name);
        }
    }
    
    ## figure out deletions we'll do later
    foreach my $bit (@{$req->{'delete'}})
    {
        $bit += 0;
        next unless ($bit >= 1 && $bit <= 30);
        $bitset{$bit} = 0;  # so later we replace into, not update.
    }

    ## do additions/modifications ('set' hash)
    my %added;
    foreach my $bit (keys %{$req->{'set'}})
    {
        $bit += 0;
        next unless ($bit >= 1 && $bit <= 30);
        my $sa = $req->{'set'}->{$bit};
        my $name = LJ::text_trim($sa->{'name'}, $bmax, $cmax);

        # can't end with a slash
        $name =~ s!/$!!;        

        # setting it to name is like deleting it.
        unless ($name =~ /\S/) {
            push @{$req->{'delete'}}, $bit;
            next;
        }

        my $qname = $db->quote($name);
        my $qsort = defined $sa->{'sort'} ? ($sa->{'sort'}+0) : 50;
        my $qpublic = $db->quote(defined $sa->{'public'} ? ($sa->{'public'}+0) : 0);

        if ($bitset{$bit}) {
            # so update it
            my $sets;
            if (defined $sa->{'public'}) {
                $sets .= ", is_public=$qpublic";
            }
            $db->do("UPDATE $fgtable SET groupname=$qname, sortorder=$qsort ".
                    "$sets WHERE userid=$userid AND groupnum=$bit");
        } else {
            $db->do("REPLACE INTO $fgtable (userid, groupnum, ".
                    "groupname, sortorder, is_public) VALUES ".
                    "($userid, $bit, $qname, $qsort, $qpublic)");
        }
        $added{$bit} = 1;
    }


    ## do deletions ('delete' array)
    my $dbcm = LJ::get_cluster_master($u);

    # ignore bits that aren't integers or that are outside 1-30 range
    my @delete_bits = grep {$_ >= 1 and $_ <= 30} map {$_+0} @{$req->{'delete'}};
    my $delete_mask = 0;
    foreach my $bit (@delete_bits) {
        $delete_mask |= (1 << $bit)
    }

    # remove the bits for deleted groups from all friends groupmasks
    my $dbh = LJ::get_db_writer();
    if ($delete_mask) {
        # TAG:FR:protocol:editfriendgroups_removemasks
        $dbh->do("UPDATE friends".
                 "   SET groupmask = groupmask & ~$delete_mask".
                 " WHERE userid = $userid");
    }

    foreach my $bit (@delete_bits)
    {
        # remove all posts from allowing that group:
        my @posts_to_clean = ();
        $sth = $dbcm->prepare("SELECT jitemid FROM logsec2 WHERE journalid=$userid AND allowmask & (1 << $bit)");
        $sth->execute;
        while (my ($id) = $sth->fetchrow_array) { push @posts_to_clean, $id; }
        while (@posts_to_clean) {
            my @batch;
            if (scalar(@posts_to_clean) < 20) {
                @batch = @posts_to_clean;
                @posts_to_clean = ();
            } else {
                @batch = splice(@posts_to_clean, 0, 20);
            }

            my $in = join(",", @batch);
            $u->do("UPDATE log2 SET allowmask=allowmask & ~(1 << $bit) ".
                   "WHERE journalid=$userid AND jitemid IN ($in) AND security='usemask'");
            $u->do("UPDATE logsec2 SET allowmask=allowmask & ~(1 << $bit) ".
                   "WHERE journalid=$userid AND jitemid IN ($in)");

            foreach my $id (@batch) {
                LJ::MemCache::delete([$userid, "log2:$userid:$id"]);
            }
            LJ::MemCache::delete([$userid, "log2lt:$userid"]);
        }
        LJ::Tags::deleted_friend_group($u, $bit);
        LJ::run_hooks('delete_friend_group', $u, $bit);

        # remove the friend group, unless we just added it this transaction
        unless ($added{$bit}) {
            $db->do("DELETE FROM $fgtable WHERE ".
                    "userid=$userid AND groupnum=$bit");
        }
    }

    ## change friends' masks
    # TAG:FR:protocol:editfriendgroups_changemasks
    foreach my $friend (keys %{$req->{'groupmasks'}})
    {
        my $mask = int($req->{'groupmasks'}->{$friend}) | 1;
        my $friendid = LJ::get_userid($dbh, $friend);

        $dbh->do("UPDATE friends SET groupmask=$mask ".
                 "WHERE userid=$userid AND friendid=?",
                 undef, $friendid);
        LJ::MemCache::set([$userid, "frgmask:$userid:$friendid"], $mask);
    }

    # invalidate memcache of friends/groups
    LJ::memcache_kill($userid, "friends");
    LJ::memcache_kill($userid, "fgrp");
    LJ::mark_dirty($u, "friends");

    # return value for this is nothing.
    return {};
}

sub sessionexpire {
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);
    my $u = $flags->{u};

    # expunge one? or all?
    if ($req->{expireall}) {
        $u->kill_all_sessions;
        return {};
    }

    # just expire a list
    my $list = $req->{expire} || [];
    return {} unless @$list;
    return fail($err,502) unless $u->writer;
    $u->kill_sessions(@$list);
    return {};
}

sub sessiongenerate {
    # generate a session
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);

    # sanitize input
    $req->{expiration} = 'short' unless $req->{expiration} eq 'long';
    my $boundip;
    $boundip = LJ::get_remote_ip() if $req->{bindtoip};
    
    my $u = $flags->{u};
    my $sess_opts = {
        exptype => $req->{expiration},
        ipfixed => $boundip,
    };

    # do not let locked people do this
    return fail($err, 308) if $u->{statusvis} eq 'L';

    my $sess = $u->generate_session($sess_opts);

    # return our hash
    return {
        ljsession => "ws:$u->{user}:$sess->{sessid}:$sess->{auth}",
    };
}

sub list_friends
{
    my ($u, $opts) = @_;

    my %hide_fo;  # userid -> 1
    if ($LJ::HIDE_FRIENDOF_VIA_BAN) {
        if (my $list = LJ::load_rel_user($u, 'B')) {
            $hide_fo{$_} = 1 foreach @$list;
        }
    }

    # TAG:FR:protocol:list_friends
    my $sql;
    unless ($opts->{'friendof'}) {
        $sql = "SELECT friendid, fgcolor, bgcolor, groupmask FROM friends WHERE userid=?";
    } else {
        $sql = "SELECT userid FROM friends WHERE friendid=?";
    }

    my $dbr = LJ::get_db_reader();
    my $sth = $dbr->prepare($sql);
    $sth->execute($u->{'userid'});

    my @frow;
    while (my @row = $sth->fetchrow_array) {
        next if $hide_fo{$row[0]};
        push @frow, [ @row ];
    }

    my $us = LJ::load_userids(map { $_->[0] } @frow);
    my $limitnum = $opts->{'limit'}+0;

    my $res = [];
    foreach my $f (sort { $us->{$a->[0]}{'user'} cmp $us->{$b->[0]}{'user'} }
                   grep { $us->{$_->[0]} } @frow)  
    {
        my $u = $us->{$f->[0]};
        next if $opts->{'friendof'} && $u->{'statusvis'} ne 'V';

        my $r = {
            'username' => $u->{'user'},
            'fullname' => $u->{'name'},
        };

        if ($opts->{'includebdays'} &&
            $u->{'bdate'} &&
            $u->{'bdate'} ne "0000-00-00" &&
            $u->{'allow_infoshow'} eq 'Y') 
        {
            $r->{'birthday'} = $u->{'bdate'};            
        }

        unless ($opts->{'friendof'}) {
            $r->{'fgcolor'} = LJ::color_fromdb($f->[1]);
            $r->{'bgcolor'} = LJ::color_fromdb($f->[2]);
            $r->{"groupmask"} = $f->[3] if $f->[3] != 1;
        } else {
            $r->{'fgcolor'} = "#000000";
            $r->{'bgcolor'} = "#ffffff";
        }

        $r->{"type"} = {
            'C' => 'community',
            'Y' => 'syndicated',
            'N' => 'news',
            'S' => 'shared',
            'I' => 'identity',
        }->{$u->{'journaltype'}} if $u->{'journaltype'} ne 'P';

        $r->{"status"} = {
            'D' => "deleted",
            'S' => "suspended",
            'X' => "purged",
        }->{$u->{'statusvis'}} if $u->{'statusvis'} ne 'V';

        push @$res, $r;
        # won't happen for zero limit (which means no limit)
        last if @$res == $limitnum;
    }
    return $res;
}

sub syncitems
{
    my ($req, $err, $flags) = @_;
    return undef unless authenticate($req, $err, $flags);
    return undef unless check_altusage($req, $err, $flags);
    return fail($err,506) if $LJ::DISABLED{'syncitems'};

    my $ownerid = $flags->{'ownerid'};
    my $uowner = $flags->{'u_owner'} || $flags->{'u'};
    my $sth;

    my $db = LJ::get_cluster_reader($uowner);
    return fail($err,502) unless $db;

    ## have a valid date?
    my $date = $req->{'lastsync'};
    if ($date) {
        return fail($err,203,"Invalid date format")
            unless ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
    } else {
        $date = "0000-00-00 00:00:00";
    }

    my $LIMIT = 500;

    my %item;
    $sth = $db->prepare("SELECT jitemid, logtime FROM log2 WHERE ".
                        "journalid=? and logtime > ?");
    $sth->execute($ownerid, $date);
    while (my ($id, $dt) = $sth->fetchrow_array) {
        $item{$id} = [ 'L', $id, $dt, "create" ];
    }

    my %cmt;
    my $p_calter = LJ::get_prop("log", "commentalter");
    my $p_revtime = LJ::get_prop("log", "revtime");
    $sth = $db->prepare("SELECT jitemid, propid, FROM_UNIXTIME(value) ".
                        "FROM logprop2 WHERE journalid=? ".
                        "AND propid IN ($p_calter->{'id'}, $p_revtime->{'id'}) ".
                        "AND value+0 > UNIX_TIMESTAMP(?)");
    $sth->execute($ownerid, $date);
    while (my ($id, $prop, $dt) = $sth->fetchrow_array) {
        if ($prop == $p_calter->{'id'}) {
            $cmt{$id} = [ 'C', $id, $dt, "update" ];
        } elsif ($prop == $p_revtime->{'id'}) {
            $item{$id} = [ 'L', $id, $dt, "update" ];
        }
    }
    
    my @ev = sort { $a->[2] cmp $b->[2] } (values %item, values %cmt);
    
    my $res = {};
    my $list = $res->{'syncitems'} = [];
    $res->{'total'} = scalar @ev;
    my $ct = 0;
    while (my $ev = shift @ev) {
        $ct++;
        push @$list, { 'item' => "$ev->[0]-$ev->[1]",
                       'time' => $ev->[2],
                       'action' => $ev->[3],  };
        last if $ct >= $LIMIT;
    }
    $res->{'count'} = $ct;
    return $res;
}

sub consolecommand
{
    my ($req, $err, $flags) = @_;

    my $dbh = LJ::get_db_writer();
    return fail($err,502) unless $dbh;

    # logging in isn't necessary, but most console commands do require it
    my $remote = undef;
    $remote = $flags->{'u'} if authenticate($req, $err, $flags);

    # underage users can't do this, since we don't want to sanitize for
    # what in particular they're trying to do, might as well disallow it
    return fail($err, 310) if $remote->underage;

    # do not let locked people do this
    return fail($err, 308) if $remote->{statusvis} eq 'L';

    my $res = {};
    my $cmdout = $res->{'results'} = [];

    foreach my $cmd (@{$req->{'commands'}})
    {
        # callee can pre-parse the args, or we can do it bash-style
        $cmd = [ LJ::Con::parse_line($cmd) ] unless (ref $cmd eq "ARRAY");

        my @output;
        my $rv = LJ::Con::execute($dbh, $remote, $cmd, \@output);
        push @{$cmdout}, {
            'success' => $rv,
            'output' => \@output,
        };
    }

    return $res;
}

sub getchallenge
{
    my ($req, $err, $flags) = @_;
    my $res = {};
    my $now = time();
    my $etime = 60;
    $res->{'challenge'} = LJ::challenge_generate($etime);
    $res->{'server_time'} = $now;
    $res->{'expire_time'} = $now + $etime;
    $res->{'auth_scheme'} = "c0";  # fixed for now, might support others later
    return $res;
}

sub login_message
{
    my ($req, $res, $flags) = @_;
    my $u = $flags->{'u'};

    my $msg = sub {
        my $code = shift;
        my $args = shift || {};
        $args->{'sitename'} = $LJ::SITENAME;
        $args->{'siteroot'} = $LJ::SITEROOT;
        $res->{'message'} = translate($u, $code, $args);
    };

    return $msg->("readonly")          if LJ::get_cap($u, "readonly");
    return $msg->("not_validated")     if ($u->{'status'} eq "N" and not $LJ::EVERYONE_VALID);
    return $msg->("must_revalidate")   if ($u->{'status'} eq "T" and not $LJ::EVERYONE_VALID);
    return $msg->("mail_bouncing")     if $u->{'status'} eq "B";

    my @checkpass = LJ::run_hooks("bad_password", $u);
    return $msg->("bad_password")      if (@checkpass and $checkpass[0]->[0]);
    
    return $msg->("old_win32_client")  if $req->{'clientversion'} =~ /^Win32-MFC\/(1.2.[0123456])$/;
    return $msg->("old_win32_client")  if $req->{'clientversion'} =~ /^Win32-MFC\/(1.3.[01234])\b/;
    return $msg->("hello_test")        if $u->{'user'} eq "test";
}

sub list_friendgroups
{
    my $u = shift;

    # get the groups for this user, return undef if error
    my $groups = LJ::get_friend_group($u);
    return undef unless $groups;

    # we got all of the groups, so put them into an arrayref sorted by the
    # group sortorder; also note that the map is used to construct a new hashref
    # out of the old group hashref so that we have all of the field names converted
    # to a format our callers can recognize
    my @res = map { { id => $_->{groupnum},      name => $_->{groupname},
                      public => $_->{is_public}, sortorder => $_->{sortorder}, } }
              sort { $a->{sortorder} <=> $b->{sortorder} }
              values %$groups;

    return \@res;
}

sub list_usejournals
{
    my $u = shift;

    my @res;

    my $ids = LJ::load_rel_target($u, 'P');
    my $us = LJ::load_userids(@$ids);
    foreach (values %$us) {
        next unless $_->{'statusvis'} eq "V";
        push @res, $_->{user};
    }
    @res = sort @res;
    return \@res;
}

sub hash_menus
{
    my $u = shift;
    my $user = $u->{'user'};

    my $menu = [
                { 'text' => "Recent Entries",
                  'url' => "$LJ::SITEROOT/users/$user/", },
                { 'text' => "Calendar View",
                  'url' => "$LJ::SITEROOT/users/$user/calendar", },
                { 'text' => "Friends View",
                  'url' => "$LJ::SITEROOT/users/$user/friends", },
                { 'text' => "-", },
                { 'text' => "Your Profile",
                  'url' => "$LJ::SITEROOT/userinfo.bml?user=$user", },
                { 'text' => "Your To-Do List",
                  'url' => "$LJ::SITEROOT/todo/?user=$user", },
                { 'text' => "-", },
                { 'text' => "Change Settings",
                  'sub' => [ { 'text' => "Personal Info",
                               'url' => "$LJ::SITEROOT/editinfo.bml", },
                             { 'text' => "Journal Settings",
                               'url' =>"$LJ::SITEROOT/modify.bml", }, ] },
                { 'text' => "-", },
                { 'text' => "Support",
                  'url' => "$LJ::SITEROOT/support/", }
                ];

    LJ::run_hooks("modify_login_menu", {
        'menu' => $menu,
        'u' => $u,
        'user' => $user,
    });

    return $menu;
}

sub list_pickws
{
    my $u = shift;

    my $pi = LJ::get_userpic_info($u);
    my @res;

    # FIXME: should be a utf-8 sort
    foreach my $kw (sort keys %{$pi->{'kw'}}) {
        my $pic = $pi->{'kw'}{$kw};
        next if $pic->{'state'} eq "I";
        push @res, [ $kw, $pic->{'picid'} ];
    }

    return \@res;
}

sub list_moods
{
    my $mood_max = int(shift);
    LJ::load_moods();

    my $res = [];
    return $res if $mood_max >= $LJ::CACHED_MOOD_MAX;

    for (my $id = $mood_max+1; $id <= $LJ::CACHED_MOOD_MAX; $id++) {
        next unless defined $LJ::CACHE_MOODS{$id};
        my $mood = $LJ::CACHE_MOODS{$id};
        next unless $mood->{'name'};
        push @$res, { 'id' => $id,
                      'name' => $mood->{'name'},
                      'parent' => $mood->{'parent'} };
    }

    return $res;
}

sub check_altusage
{
    my ($req, $err, $flags) = @_;

    # see note in ljlib.pl::can_use_journal about why we return
    # both 'ownerid' and 'u_owner' in $flags

    my $alt = $req->{'usejournal'};
    my $u = $flags->{'u'};
    $flags->{'ownerid'} = $u->{'userid'};

    # all good if not using an alt journal
    return 1 unless $alt;

    # complain if the username is invalid
    return fail($err,206) unless LJ::canonical_username($alt);

    my $r = eval { Apache->request };

    # allow usage if we're told explicitly that it's okay
    if ($flags->{'usejournal_okay'}) {
        $flags->{'u_owner'} = LJ::load_user($alt);
        $flags->{'ownerid'} = $flags->{'u_owner'}->{'userid'};
        $r->notes("journalid" => $flags->{'ownerid'}) if $r && !$r->notes("journalid");
        return 1 if $flags->{'ownerid'};
        return fail($err,206);
    }

    # otherwise, check for access:
    my $info = {};
    my $canuse = LJ::can_use_journal($u->{'userid'}, $alt, $info);
    $flags->{'ownerid'} = $info->{'ownerid'};
    $flags->{'u_owner'} = $info->{'u_owner'};
    $r->notes("journalid" => $flags->{'ownerid'}) if $r && !$r->notes("journalid");

    return 1 if $canuse || $flags->{'ignorecanuse'};

    # not allowed to access it
    return fail($err,300);
}

sub authenticate
{
    my ($req, $err, $flags) = @_;

    my $username = $req->{'username'};
    return fail($err,200) unless $username;
    return fail($err,100) unless LJ::canonical_username($username);

    my $u = $flags->{'u'};
    unless ($u) {
        my $dbr = LJ::get_db_reader();
        return fail($err,502) unless $dbr;
        $u = LJ::load_user($username);
    }

    return fail($err,100) unless $u;
    return fail($err,100) if ($u->{'statusvis'} eq "X");
    return fail($err,505) unless $u->{'clusterid'};

    my $r = eval { Apache->request };
    my $ip;
    if ($r) {
        $r->notes("ljuser" => $u->{'user'}) unless $r->notes("ljuser");
        $r->notes("journalid" => $u->{'userid'}) unless $r->notes("journalid");
        $ip = $r->connection->remote_ip;
    }

    my $ip_banned = 0;
    my $chal_expired = 0;
    my $auth_check = sub {
        my $auth_meth = $req->{'auth_method'} || "clear";
        if ($auth_meth eq "clear") {
            return LJ::auth_okay($u,
                                 $req->{'password'},
                                 $req->{'hpassword'},
                                 $u->{'password'},
                                 \$ip_banned);
        }
        if ($auth_meth eq "challenge") {
            my $chal_opts = {};
            my $chall_ok = LJ::challenge_check_login($u, 
                                                     $req->{'auth_challenge'},
                                                     $req->{'auth_response'},
                                                     \$ip_banned,
                                                     $chal_opts);
            $chal_expired = 1 if $chal_opts->{expired};
            return $chall_ok;
        }
        if ($auth_meth eq "cookie") {
            return unless $r && $r->header_in("X-LJ-Auth") eq "cookie";
            my $remote = LJ::get_remote();
            return $remote && $remote->{'user'} eq $username ? 1 : 0;
        }
    };

    # predefined allowed auths (no pw required)
    my $post_wo_auth = $LJ::POST_WITHOUT_AUTH{$ip};
    $flags->{'noauth'} = 1 if
        $post_wo_auth &&
        $post_wo_auth->{ $req->{usejournal} } &&
        grep { $_ eq $req->{user} } @{ $post_wo_auth->{ $req->{usejournal} } };

    unless ($flags->{'nopassword'} ||
            $flags->{'noauth'} ||
            $auth_check->() )
    {
        return fail($err,402) if $ip_banned;
        return fail($err,105) if $chal_expired;
        return fail($err,101);
    }

    # if there is a require TOS revision, check for it now
    return fail($err, 156, LJ::tosagree_str('protocol' => 'text'))
        unless $u->tosagree_verify;

    # remember the user record for later.
    $flags->{'u'} = $u;
    return 1;
}

sub fail
{
    my $err = shift;
    my $code = shift;
    my $des = shift;
    $code .= ":$des" if $des;
    $$err = $code if (ref $err eq "SCALAR");
    return undef;
}

# PROBLEM: a while back we used auto_increment fields in our tables so that we could have
# automatically incremented itemids and such.  this was eventually phased out in favor of
# the more portable alloc_user_counter function which uses the 'counter' table.  when the
# counter table has no data, it finds the highest id already in use in the database and adds
# one to it.
#
# a problem came about when users who last posted before alloc_user_counter went
# and deleted all their entries and posted anew.  alloc_user_counter would find no entries,
# this no ids, and thus assign id 1, thinking it's all clean and new.  but, id 1 had been
# used previously, and now has comments attached to it.
#
# the comments would happen because there was an old bug that wouldn't delete comments when
# an entry was deleted.  this has since been fixed.  so this all combines to make this
# a necessity, at least until no buggy data exist anymore!
#
# this code here removes any comments that happen to exist for the id we're now using.
sub new_entry_cleanup_hack {
    my ($u, $jitemid) = @_;

    # sanitize input
    $jitemid += 0;
    return unless $jitemid;
    my $ownerid = LJ::want_userid($u);
    return unless $ownerid;

    # delete logprops
    $u->do("DELETE FROM logprop2 WHERE journalid=$ownerid AND jitemid=$jitemid");

    # delete comments
    my $ids = LJ::Talk::get_talk_data($u, 'L', $jitemid);
    return unless ref $ids eq 'HASH' && %$ids;
    my $list = join ',', map { $_+0 } keys %$ids;
    $u->do("DELETE FROM talk2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
    $u->do("DELETE FROM talktext2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
    $u->do("DELETE FROM talkprop2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
}

#### Old interface (flat key/values) -- wrapper aruond LJ::Protocol
package LJ;

sub do_request
{
    # get the request and response hash refs
    my ($req, $res, $flags) = @_;

    # initialize some stuff
    %{$res} = ();                      # clear the given response hash
    $flags = {} unless (ref $flags eq "HASH");

    # did they send a mode?
    unless ($req->{'mode'}) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = "Client error: No mode specified.";
        return;
    }

    # this method doesn't require auth
    if ($req->{'mode'} eq "getchallenge") {
        return getchallenge($req, $res, $flags);
    }

    # mode from here on out require a username
    my $user = LJ::canonical_username($req->{'user'});
    unless ($user) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = "Client error: No username sent.";
        return;
    }

    ### see if the server's under maintenance now
    if ($LJ::SERVER_DOWN) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = $LJ::SERVER_DOWN_MESSAGE;
        return;
    }

    ## dispatch wrappers
    if ($req->{'mode'} eq "login") {
        return login($req, $res, $flags);
    }
    if ($req->{'mode'} eq "getfriendgroups") {
        return getfriendgroups($req, $res, $flags);
    }
    if ($req->{'mode'} eq "getfriends") {
        return getfriends($req, $res, $flags);
    }
    if ($req->{'mode'} eq "friendof") {
        return friendof($req, $res, $flags);
    }
    if ($req->{'mode'} eq "checkfriends") {
        return checkfriends($req, $res, $flags);
    }
    if ($req->{'mode'} eq "getdaycounts") {
        return getdaycounts($req, $res, $flags);
    }
    if ($req->{'mode'} eq "postevent") {
        return postevent($req, $res, $flags);
    }
    if ($req->{'mode'} eq "editevent") {
        return editevent($req, $res, $flags);
    }
    if ($req->{'mode'} eq "syncitems") {
        return syncitems($req, $res, $flags);
    }
    if ($req->{'mode'} eq "getevents") {
        return getevents($req, $res, $flags);
    }
    if ($req->{'mode'} eq "editfriends") {
        return editfriends($req, $res, $flags);
    }
    if ($req->{'mode'} eq "editfriendgroups") {
        return editfriendgroups($req, $res, $flags);
    }
    if ($req->{'mode'} eq "consolecommand") {
        return consolecommand($req, $res, $flags);
    }
    if ($req->{'mode'} eq "sessiongenerate") {
        return sessiongenerate($req, $res, $flags);
    }
    if ($req->{'mode'} eq "sessionexpire") {
        return sessionexpire($req, $res, $flags);
    }

    ### unknown mode!
    $res->{'success'} = "FAIL";
    $res->{'errmsg'} = "Client error: Unknown mode ($req->{'mode'})";
    return;
}

## flat wrapper
sub login
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    my $rs = LJ::Protocol::do_request("login", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'success'} = "OK";
    $res->{'name'} = $rs->{'fullname'};
    $res->{'message'} = $rs->{'message'} if $rs->{'message'};
    $res->{'fastserver'} = 1 if $rs->{'fastserver'};

    # shared journals
    my $access_count = 0;
    foreach my $user (@{$rs->{'usejournals'}}) {
        $access_count++;
        $res->{"access_${access_count}"} = $user;
    }
    if ($access_count) {
        $res->{"access_count"} = $access_count;
    }

    # friend groups
    populate_friend_groups($res, $rs->{'friendgroups'});

    my $flatten = sub {
        my ($prefix, $listref) = @_;
        my $ct = 0;
        foreach (@$listref) {
            $ct++;
            $res->{"${prefix}_$ct"} = $_;
        }
        $res->{"${prefix}_count"} = $ct;
    };

    ### picture keywords
    $flatten->("pickw", $rs->{'pickws'})
        if defined $req->{"getpickws"};
    $flatten->("pickwurl", $rs->{'pickwurls'})
        if defined $req->{"getpickwurls"};
    $res->{'defaultpicurl'} = $rs->{'defaultpicurl'} if $rs->{'defaultpicurl'};

    ### report new moods that this client hasn't heard of, if they care
    if (defined $req->{"getmoods"}) {
        my $mood_count = 0;
        foreach my $m (@{$rs->{'moods'}}) {
            $mood_count++;
            $res->{"mood_${mood_count}_id"} = $m->{'id'};
            $res->{"mood_${mood_count}_name"} = $m->{'name'};
            $res->{"mood_${mood_count}_parent"} = $m->{'parent'};
        }
        if ($mood_count) {
            $res->{"mood_count"} = $mood_count;
        }
    }

    #### send web menus
    if ($req->{"getmenus"} == 1) {
        my $menu = $rs->{'menus'};
        my $menu_num = 0;
        populate_web_menu($res, $menu, \$menu_num);
    }

    return 1;
}

## flat wrapper
sub getfriendgroups
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    my $rs = LJ::Protocol::do_request("getfriendgroups", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }
    $res->{'success'} = "OK";
    populate_friend_groups($res, $rs->{'friendgroups'});

    return 1;
}

## flat wrapper
sub getfriends
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    my $rs = LJ::Protocol::do_request("getfriends", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'success'} = "OK";
    if ($req->{'includegroups'}) {
        populate_friend_groups($res, $rs->{'friendgroups'});
    }
    if ($req->{'includefriendof'}) {
        populate_friends($res, "friendof", $rs->{'friendofs'});
    }
    populate_friends($res, "friend", $rs->{'friends'});

    return 1;
}

## flat wrapper
sub friendof
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    my $rs = LJ::Protocol::do_request("friendof", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'success'} = "OK";
    populate_friends($res, "friendof", $rs->{'friendofs'});
    return 1;
}

## flat wrapper
sub checkfriends
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    my $rs = LJ::Protocol::do_request("checkfriends", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'success'} = "OK";
    $res->{'new'} = $rs->{'new'};
    $res->{'lastupdate'} = $rs->{'lastupdate'};
    $res->{'interval'} = $rs->{'interval'};
    return 1;
}

## flat wrapper
sub getdaycounts
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    my $rs = LJ::Protocol::do_request("getdaycounts", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'success'} = "OK";
    foreach my $d (@{ $rs->{'daycounts'} }) {
        $res->{$d->{'date'}} = $d->{'count'};
    }
    return 1;
}

## flat wrapper
sub syncitems
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    my $rs = LJ::Protocol::do_request("syncitems", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'success'} = "OK";
    $res->{'sync_total'} = $rs->{'total'};
    $res->{'sync_count'} = $rs->{'count'};
    
    my $ct = 0;
    foreach my $s (@{ $rs->{'syncitems'} }) {
        $ct++;
        foreach my $a (qw(item action time)) {
            $res->{"sync_${ct}_$a"} = $s->{$a};
        }
    }
    return 1;
}

## flat wrapper: limited functionality.  (1 command only, server-parsed only)
sub consolecommand
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);
    delete $rq->{'command'};

    $rq->{'commands'} = [ $req->{'command'} ];

    my $rs = LJ::Protocol::do_request("consolecommand", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'cmd_success'} = $rs->{'results'}->[0]->{'success'};
    $res->{'cmd_line_count'} = 0;
    foreach my $l (@{$rs->{'results'}->[0]->{'output'}}) {
        $res->{'cmd_line_count'}++;
        my $line = $res->{'cmd_line_count'};
        $res->{"cmd_line_${line}_type"} = $l->[0]
            if $l->[0];
        $res->{"cmd_line_${line}"} = $l->[1];
    }

    $res->{'success'} = "OK";

}

## flat wrapper
sub getchallenge
{
    my ($req, $res, $flags) = @_;
    my $err = 0;
    my $rs = LJ::Protocol::do_request("getchallenge", $req, \$err, $flags);

    # stupid copy (could just return $rs), but it might change in the future
    # so this protects us from future accidental harm.
    foreach my $k (qw(challenge server_time expire_time auth_scheme)) {
        $res->{$k} = $rs->{$k};
    }

    $res->{'success'} = "OK";
    return $res;
}

## flat wrapper
sub editfriends
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    $rq->{'add'} = [];
    $rq->{'delete'} = [];

    foreach (keys %$req) {
        if (/^editfriend_add_(\d+)_user$/) {
            my $n = $1;
            next unless ($req->{"editfriend_add_${n}_user"} =~ /\S/);
            my $fa = { 'username' => $req->{"editfriend_add_${n}_user"},
                       'fgcolor' => $req->{"editfriend_add_${n}_fg"},
                       'bgcolor' => $req->{"editfriend_add_${n}_bg"},
                       'groupmask' => $req->{"editfriend_add_${n}_groupmask"},
                   };
            push @{$rq->{'add'}}, $fa;
        } elsif (/^editfriend_delete_(\w+)$/) {
            push @{$rq->{'delete'}}, $1;
        }
    }

    my $rs = LJ::Protocol::do_request("editfriends", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'success'} = "OK";

    my $ct = 0;
    foreach my $fa (@{ $rs->{'added'} }) {
        $ct++;
        $res->{"friend_${ct}_user"} = $fa->{'username'};
        $res->{"friend_${ct}_name"} = $fa->{'fullname'};
    }

    $res->{'friends_added'} = $ct;

    return 1;
}

## flat wrapper
sub editfriendgroups
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    $rq->{'groupmasks'} = {};
    $rq->{'set'} = {};
    $rq->{'delete'} = [];

    foreach (keys %$req) {
        if (/^efg_set_(\d+)_name$/) {
            next unless ($req->{$_} ne "");
            my $n = $1;
            my $fs = {
                'name' => $req->{"efg_set_${n}_name"},
                'sort' => $req->{"efg_set_${n}_sort"},
            };
            if (defined $req->{"efg_set_${n}_public"}) {
                $fs->{'public'} = $req->{"efg_set_${n}_public"};
            }
            $rq->{'set'}->{$n} = $fs;
        }
        elsif (/^efg_delete_(\d+)$/) {
            if ($req->{$_}) {
                # delete group if value is true
                push @{$rq->{'delete'}}, $1;
            }
        }
        elsif (/^editfriend_groupmask_(\w+)$/) {
            $rq->{'groupmasks'}->{$1} = $req->{$_};
        }
    }

    my $rs = LJ::Protocol::do_request("editfriendgroups", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'success'} = "OK";
    return 1;
}

sub flatten_props
{
    my ($req, $rq) = @_;

    ## changes prop_* to props hashref
    foreach my $k (keys %$req) {
        next unless ($k =~ /^prop_(.+)/);
        $rq->{'props'}->{$1} = $req->{$k};
    }
}

## flat wrapper
sub postevent
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);
    flatten_props($req, $rq);

    my $rs = LJ::Protocol::do_request("postevent", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'message'} = $rs->{'message'} if $rs->{'message'};
    $res->{'success'} = "OK";
    $res->{'itemid'} = $rs->{'itemid'};
    $res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
    $res->{'url'} = $rs->{'url'} if defined $rs->{'url'};
    return 1;
}

## flat wrapper
sub editevent
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);
    flatten_props($req, $rq);

    my $rs = LJ::Protocol::do_request("editevent", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    $res->{'success'} = "OK";
    $res->{'itemid'} = $rs->{'itemid'};
    $res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
    $res->{'url'} = $rs->{'url'} if defined $rs->{'url'};
    return 1;
}

## flat wrapper
sub sessiongenerate {
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    my $rs = LJ::Protocol::do_request('sessiongenerate', $rq, \$err, $flags);
    unless ($rs) {
        $res->{success} = 'FAIL';
        $res->{errmsg} = LJ::Protocol::error_message($err);
    }

    $res->{success} = 'OK';
    $res->{ljsession} = $rs->{ljsession};
    return 1;
}

## flat wrappre
sub sessionexpire {
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    $rq->{expire} = [];
    foreach my $k (keys %$rq) {
        push @{$rq->{expire}}, $1 
            if $k =~ /^expire_id_(\d+)$/;
    }

    my $rs = LJ::Protocol::do_request('sessionexpire', $rq, \$err, $flags);
    unless ($rs) {
        $res->{success} = 'FAIL';
        $res->{errmsg} = LJ::Protocol::error_message($err);
    }

    $res->{success} = 'OK';
    return 1;
}

## flat wrapper
sub getevents
{
    my ($req, $res, $flags) = @_;

    my $err = 0;
    my $rq = upgrade_request($req);

    my $rs = LJ::Protocol::do_request("getevents", $rq, \$err, $flags);
    unless ($rs) {
        $res->{'success'} = "FAIL";
        $res->{'errmsg'} = LJ::Protocol::error_message($err);
        return 0;
    }

    my $ect = 0;
    my $pct = 0;
    foreach my $evt (@{$rs->{'events'}}) {
        $ect++;
        foreach my $f (qw(itemid eventtime security allowmask subject anum url poster)) {
            if (defined $evt->{$f}) {
                $res->{"events_${ect}_$f"} = $evt->{$f};
            }
        }
        $res->{"events_${ect}_event"} = LJ::eurl($evt->{'event'});

        if ($evt->{'props'}) {
            foreach my $k (sort keys %{$evt->{'props'}}) {
                $pct++;
                $res->{"prop_${pct}_itemid"} = $evt->{'itemid'};
                $res->{"prop_${pct}_name"} = $k;
                $res->{"prop_${pct}_value"} = $evt->{'props'}->{$k};
            }
        }
    }

    unless ($req->{'noprops'}) {
        $res->{'prop_count'} = $pct;
    }
    $res->{'events_count'} = $ect;
    $res->{'success'} = "OK";

    return 1;
}


sub populate_friends
{
    my ($res, $pfx, $list) = @_;
    my $count = 0;
    foreach my $f (@$list)
    {
        $count++;
        $res->{"${pfx}_${count}_name"} = $f->{'fullname'};
        $res->{"${pfx}_${count}_user"} = $f->{'username'};
        $res->{"${pfx}_${count}_birthday"} = $f->{'birthday'} if $f->{'birthday'}; 
        $res->{"${pfx}_${count}_bg"} = $f->{'bgcolor'};
        $res->{"${pfx}_${count}_fg"} = $f->{'fgcolor'};
        if (defined $f->{'groupmask'}) {
            $res->{"${pfx}_${count}_groupmask"} = $f->{'groupmask'};
        }
        if (defined $f->{'type'}) {
            $res->{"${pfx}_${count}_type"} = $f->{'type'};
        }
        if (defined $f->{'status'}) {
            $res->{"${pfx}_${count}_status"} = $f->{'status'};
        }
    }
    $res->{"${pfx}_count"} = $count;
}


sub upgrade_request
{
    my $r = shift;
    my $new = { %{ $r } };
    $new->{'username'} = $r->{'user'};

    # but don't delete $r->{'user'}, as it might be, say, %FORM,
    # that'll get reused in a later request in, say, update.bml after
    # the login before postevent.  whoops.

    return $new;
}

## given a $res hashref and friend group subtree (arrayref), flattens it
sub populate_friend_groups
{
    my ($res, $fr) = @_;

    my $maxnum = 0;
    foreach my $fg (@$fr)
    {
        my $num = $fg->{'id'};
        $res->{"frgrp_${num}_name"} = $fg->{'name'};
        $res->{"frgrp_${num}_sortorder"} = $fg->{'sortorder'};
        if ($fg->{'public'}) {
            $res->{"frgrp_${num}_public"} = 1;
        }
        if ($num > $maxnum) { $maxnum = $num; }
    }
    $res->{'frgrp_maxnum'} = $maxnum;
}

## given a menu tree, flattens it into $res hashref
sub populate_web_menu
{
    my ($res, $menu, $numref) = @_;
    my $mn = $$numref;  # menu number
    my $mi = 0;         # menu item
    foreach my $it (@$menu) {
        $mi++;
        $res->{"menu_${mn}_${mi}_text"} = $it->{'text'};
        if ($it->{'text'} eq "-") { next; }
        if ($it->{'sub'}) {
            $$numref++;
            $res->{"menu_${mn}_${mi}_sub"} = $$numref;
            &populate_web_menu($res, $it->{'sub'}, $numref);
            next;

        }
        $res->{"menu_${mn}_${mi}_url"} = $it->{'url'};
    }
    $res->{"menu_${mn}_count"} = $mi;
}

1;