Context Navigation

ljprotocol.pl

Visit:

Revision 16385, 144.4 KB (checked in by vsukhanov, 15 hours ago)
LJSUP-5445: use 'Storable::nfreeze' instead of 'Storable::freeze'.
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`

Line
1	#!/usr/bin/perl
2	#
3
4	use strict;
5	no warnings 'uninitialized';
6
7	use LJ::Constants;
8	use Class::Autouse qw(
9	LJ::Console
10	LJ::Event::JournalNewEntry
11	LJ::Event::UserNewEntry
12	LJ::Event::Befriended
13	LJ::Entry
14	LJ::Poll
15	LJ::EventLogRecord::NewEntry
16	LJ::EventLogRecord::EditEntry
17	LJ::Config
18	LJ::Comment
19	LJ::RateLimit
20	);
21
22	LJ::Config->load;
23
24	use lib "$ENV{LJHOME}/cgi-bin";
25
26	require "taglib.pl";
27
28	# have to do this else mailgate will croak with email posting, but only want
29	# to do it if the site has enabled the hack
30	require "talklib.pl" if $LJ::NEW_ENTRY_CLEANUP_HACK;
31
32	# when posting or editing ping hubbub
33	require "ljfeed.pl" unless $LJ::DISABLED{'hubbub'};
34
35	#### New interface (meta handler) ... other handlers should call into this.
36	package LJ::Protocol;
37
38	# global declaration of this text since we use it in two places
39	our $CannotBeShown = '(cannot be shown)';
40
41	# error classes
42	use constant E_TEMP => 0;
43	use constant E_PERM => 1;
44	# maximum items for get_friends_page function
45	use constant FRIEND_ITEMS_LIMIT => 50;
46
47	my %e = (
48	# User Errors
49	"100" => [ E_PERM, "Invalid username" ],
50	"101" => [ E_PERM, "Invalid password" ],
51	"102" => [ E_PERM, "Can't use custom/private security on shared/community journals." ],
52	"103" => [ E_PERM, "Poll error" ],
53	"104" => [ E_TEMP, "Error adding one or more friends" ],
54	"105" => [ E_PERM, "Challenge expired" ],
55	"150" => [ E_PERM, "Can't post as non-user" ],
56	"151" => [ E_TEMP, "Banned from journal" ],
57	"152" => [ E_PERM, "Can't make back-dated entries in non-personal journal." ],
58	"153" => [ E_PERM, "Incorrect time value" ],
59	"154" => [ E_PERM, "Can't add a redirected account as a friend" ],
60	"155" => [ E_TEMP, "Non-authenticated email address" ],
61	"156" => [ E_TEMP, sub { # to reload w/o restart
62	LJ::tosagree_str('protocol' => 'text') \|\|
63	LJ::tosagree_str('protocol' => 'title')
64	} ],
65	"157" => [ E_TEMP, "Tags error" ],
66
67	# Client Errors
68	"200" => [ E_PERM, "Missing required argument(s)" ],
69	"201" => [ E_PERM, "Unknown method" ],
70	"202" => [ E_PERM, "Too many arguments" ],
71	"203" => [ E_PERM, "Invalid argument(s)" ],
72	"204" => [ E_PERM, "Invalid metadata datatype" ],
73	"205" => [ E_PERM, "Unknown metadata" ],
74	"206" => [ E_PERM, "Invalid destination journal username." ],
75	"207" => [ E_PERM, "Protocol version mismatch" ],
76	"208" => [ E_PERM, "Invalid text encoding" ],
77	"209" => [ E_PERM, "Parameter out of range" ],
78	"210" => [ E_PERM, "Client tried to edit with corrupt data. Preventing." ],
79	"211" => [ E_PERM, "Invalid or malformed tag list" ],
80	"212" => [ E_PERM, "Message body is too long" ],
81	"213" => [ E_PERM, "Message body is empty" ],
82	"214" => [ E_PERM, "Message looks like spam" ],
83
84
85	# Access Errors
86	"300" => [ E_TEMP, "Don't have access to requested journal" ],
87	"301" => [ E_TEMP, "Access of restricted feature" ],
88	"302" => [ E_TEMP, "Can't edit post from requested journal" ],
89	"303" => [ E_TEMP, "Can't edit post in community journal" ],
90	"304" => [ E_TEMP, "Can't delete post in this community journal" ],
91	"305" => [ E_TEMP, "Action forbidden; account is suspended." ],
92	"306" => [ E_TEMP, "This journal is temporarily in read-only mode. Try again in a couple minutes." ],
93	"307" => [ E_PERM, "Selected journal no longer exists." ],
94	"308" => [ E_TEMP, "Account is locked and cannot be used." ],
95	"309" => [ E_PERM, "Account is marked as a memorial." ],
96	"310" => [ E_TEMP, "Account needs to be age verified before use." ],
97	"311" => [ E_TEMP, "Access temporarily disabled." ],
98	"312" => [ E_TEMP, "Not allowed to add tags to entries in this journal" ],
99	"313" => [ E_TEMP, "Must use existing tags for entries in this journal (can't create new ones)" ],
100	"314" => [ E_PERM, "Only paid users allowed to use this request" ],
101	"315" => [ E_PERM, "User messaging is currently disabled" ],
102	"316" => [ E_TEMP, "Poster is read-only and cannot post entries." ],
103	"317" => [ E_TEMP, "Journal is read-only and entries cannot be posted to it." ],
104	"318" => [ E_TEMP, "Poster is read-only and cannot edit entries." ],
105	"319" => [ E_TEMP, "Journal is read-only and its entries cannot be edited." ],
106	"320" => [ E_TEMP, "Sorry, there was a problem with content of the entry" ],
107	"321" => [ E_TEMP, "Sorry, deleting is temporary disabled. Entry is 'private' now" ],
108
109	# Limit errors
110	"402" => [ E_TEMP, "Your IP address is temporarily banned for exceeding the login failure rate." ],
111	"404" => [ E_TEMP, "Cannot post" ],
112	"405" => [ E_TEMP, "Post frequency limit." ],
113	"406" => [ E_TEMP, "Client is making repeated requests. Perhaps it's broken?" ],
114	"407" => [ E_TEMP, "Moderation queue full" ],
115	"408" => [ E_TEMP, "Maximum queued posts for this community+poster combination reached." ],
116	"409" => [ E_PERM, "Post too large." ],
117	"410" => [ E_PERM, "Your trial account has expired. Posting now disabled." ],
118	"411" => [ E_TEMP, "Action frequency limit." ],
119
120	# Server Errors
121	"500" => [ E_TEMP, "Internal server error" ],
122	"501" => [ E_TEMP, "Database error" ],
123	"502" => [ E_TEMP, "Database temporarily unavailable" ],
124	"503" => [ E_TEMP, "Error obtaining necessary database lock" ],
125	"504" => [ E_PERM, "Protocol mode no longer supported." ],
126	"505" => [ E_TEMP, "Account data format on server is old and needs to be upgraded." ], # cluster0
127	"506" => [ E_TEMP, "Journal sync temporarily unavailable." ],
128	);
129
130	sub translate
131	{
132	my ($u, $msg, $vars) = @_;
133
134	LJ::load_user_props($u, "browselang") unless $u->{'browselang'};
135	return LJ::Lang::get_text($u->{'browselang'}, "protocol.$msg", undef, $vars);
136	}
137
138	sub error_class
139	{
140	my $code = shift;
141	$code = $1 if $code =~ /^(\d\d\d):(.+)/;
142	return $e{$code} && ref $e{$code} ? $e{$code}->[0] : undef;
143	}
144
145	sub error_is_transient
146	{
147	my $class = error_class($_[0]);
148	return defined $class ? ! $class+0 : undef;
149	}
150
151	sub error_is_permanent
152	{
153	return error_class($_[0]);
154	}
155
156	sub error_message
157	{
158	my $code = shift;
159	my $des;
160	($code, $des) = ($1, $2) if $code =~ /^(\d\d\d):(.+)/;
161
162	my $prefix = "";
163	my $error =
164	$e{$code} && ref $e{$code}
165	? ( ref $e{$code}->[1] eq 'CODE' ? $e{$code}->[1]->() : $e{$code}->[1] )
166	: "BUG: Unknown error code!";
167	$prefix = "Client error: " if $code >= 200;
168	$prefix = "Server error: " if $code >= 500;
169	my $totalerror = "$prefix$error";
170	$totalerror .= ": $des" if $des;
171	return $totalerror;
172	}
173
174	sub do_request
175	{
176	# get the request and response hash refs
177	my ($method, $req, $err, $flags) = @_;
178
179	# if version isn't specified explicitly, it's version 0
180	if (ref $req eq "HASH") {
181	$req->{'ver'} \|\|= $req->{'version'};
182	$req->{'ver'} = 0 unless defined $req->{'ver'};
183	}
184
185	$flags \|\|= {};
186	my @args = ($req, $err, $flags);
187
188	LJ::Request->notes("codepath" => "protocol.$method")
189	if LJ::Request->is_inited && ! LJ::Request->notes("codepath");
190
191	if ($method eq "login") { return login(@args); }
192	if ($method eq "getfriendgroups") { return getfriendgroups(@args); }
193	if ($method eq "getfriends") { return getfriends(@args); }
194	if ($method eq "friendof") { return friendof(@args); }
195	if ($method eq "checkfriends") { return checkfriends(@args); }
196	if ($method eq "getdaycounts") { return getdaycounts(@args); }
197	if ($method eq "postevent") { return postevent(@args); }
198	if ($method eq "editevent") { return editevent(@args); }
199	if ($method eq "syncitems") { return syncitems(@args); }
200	if ($method eq "getevents") { return getevents(@args); }
201	if ($method eq "editfriends") { return editfriends(@args); }
202	if ($method eq "editfriendgroups") { return editfriendgroups(@args); }
203	if ($method eq "consolecommand") { return consolecommand(@args); }
204	if ($method eq "getchallenge") { return getchallenge(@args); }
205	if ($method eq "sessiongenerate") { return sessiongenerate(@args); }
206	if ($method eq "sessionexpire") { return sessionexpire(@args); }
207	if ($method eq "getusertags") { return getusertags(@args); }
208	if ($method eq "getfriendspage") { return getfriendspage(@args); }
209	if ($method eq "getinbox") { return getinbox(@args); }
210	if ($method eq "sendmessage") { return sendmessage(@args); }
211	if ($method eq "setmessageread") { return setmessageread(@args); }
212	if ($method eq "addcomment") { return addcomment(@args); }
213	if ($method eq 'checksession') { return checksession(@args); }
214	if ($method eq "getrecentcomments") { return getrecentcomments(@args); }
215
216	LJ::Request->notes("codepath" => "") if LJ::Request->is_inited;
217	return fail($err,201);
218	}
219
220	sub checksession {
221	my ($req, $err, $flags) = @_;
222
223	return undef
224	unless authenticate($req, $err, $flags);
225
226	my $u = $flags->{'u'};
227
228	my $session = $u->session;
229
230	return {
231	username => $u->username,
232	session => $u->id.":".$session->id.":".$session->auth,
233	caps => $u->caps,
234	usejournals => list_usejournals($u),
235	}
236	}
237
238
239	sub addcomment
240	{
241	my ($req, $err, $flags) = @_;
242	return undef unless authenticate($req, $err, $flags);
243	my $u = $flags->{'u'};
244
245	my $journal;
246	if( $req->{journal} ){
247	return fail($err,100) unless LJ::canonical_username($req->{journal});
248	$journal = LJ::load_user($req->{journal}) or return fail($err, 100);
249	return fail($err,214)
250	if LJ::Talk::Post::require_captcha_test($u, $journal, $req->{body}, $req->{ditemid});
251	}else{
252	$journal = $u;
253	}
254
255	# some additional checks
256	# return fail($err,314) unless $u->get_cap('paid');
257	return fail($err,214) if LJ::Comment->is_text_spam( \ $req->{body} );
258
259	# create
260	my $comment = LJ::Comment->create(
261	journal => $journal,
262	ditemid => $req->{ditemid},
263	parenttalkid => ($req->{parenttalkid} \|\| int($req->{parent} / 256)),
264
265	poster => $u,
266
267	body => $req->{body},
268	subject => $req->{subject},
269
270	props => { picture_keyword => $req->{prop_picture_keyword} }
271	);
272
273	# OK
274	return {
275	status => "OK",
276	commentlink => $comment->url,
277	dtalkid => $comment->dtalkid,
278	};
279	}
280
281	sub getrecentcomments {
282	my ($req, $err, $flags) = @_;
283	return undef unless authenticate($req, $err, $flags);
284	my $u = $flags->{'u'};
285	my $count = $req->{itemshow};
286	$count = 10 if !$count \|\| ($count > 100) \|\| ($count < 0);
287
288	my @recv = $u->get_recent_talkitems($count);
289	my @recv_talkids = map { $_->{'jtalkid'} } @recv;
290	my %recv_userids = map { $_->{'posterid'} => 1} @recv;
291	my $comment_text = LJ::get_talktext2($u, @recv_talkids);
292	my $users = LJ::load_userids(keys(%recv_userids));
293	foreach my $comment ( @recv ) {
294	$comment->{subject} = $comment_text->{$comment->{jtalkid}}[0];
295	$comment->{text} = $comment_text->{$comment->{jtalkid}}[1];
296
297	$comment->{text} = LJ::trim_widgets(
298	length => $req->{trim_widgets},
299	img_length => $req->{widgets_img_length},
300	text => $comment->{text},
301	read_more => '<a href="' . $comment->url . '"> ...</a>',
302	) if $req->{trim_widgets};
303
304	$comment->{text} = LJ::convert_lj_tags_to_links(
305	event => $comment->{text},
306	embed_url => $comment->url,
307	) if $req->{parseljtags};
308
309	$comment->{postername} = $users->{$comment->{posterid}}
310	&& $users->{$comment->{posterid}}->username;
311	}
312	return { status => 'OK', comments => [ @recv ] };
313	}
314
315
316	sub getfriendspage
317	{
318	my ($req, $err, $flags) = @_;
319	return undef unless authenticate($req, $err, $flags);
320	my $u = $flags->{'u'};
321
322	my $itemshow = (defined $req->{itemshow}) ? $req->{itemshow} : 100;
323	return fail($err, 209, "Bad itemshow value") if $itemshow ne int($itemshow ) or $itemshow <= 0 or $itemshow > 100;
324	my $skip = (defined $req->{skip}) ? $req->{skip} : 0;
325	return fail($err, 209, "Bad skip value") if $skip ne int($skip ) or $skip < 0 or $skip > 100;
326
327	my $lastsync = int $req->{lastsync};
328	my $before = int $req->{before};
329	my $before_count = 0;
330	my $before_skip = 0;
331	if ($before){
332	$before_skip = $skip + 0;
333	$skip = 0;
334	}
335
336	my @entries = LJ::get_friend_items({
337	'u' => $u,
338	'userid' => $u->{'userid'},
339	'remote' => $u,
340	'itemshow' => $itemshow,
341	'skip' => $skip,
342	'dateformat' => 'S2',
343	});
344
345	my @attrs = qw/subject_raw event_raw journalid posterid ditemid security reply_count userpic/;
346
347	my @uids;
348
349	my @res = ();
350	while (my $ei = shift @entries) {
351
352	next unless $ei;
353
354	# exit cycle if maximum friend items limit reached
355	last
356	if scalar @res >= FRIEND_ITEMS_LIMIT;
357
358	# if passed lastsync argument - skip items with logtime less than lastsync
359	if($lastsync) {
360	next
361	if $LJ::EndOfTime - $ei->{rlogtime} <= $lastsync;
362	}
363
364	if($before) {
365	last if @res >= $itemshow;
366	push @entries, LJ::get_friend_items({
367	'u' => $u,
368	'userid' => $u->{'userid'},
369	'remote' => $u,
370	'itemshow' => $itemshow,
371	'skip' => $skip + ($before_count += $itemshow),
372	'dateformat' => 'S2',
373	}) unless @entries;
374	next if $LJ::EndOfTime - $ei->{rlogtime} > $before;
375	next if $before_skip-- > 0;
376	}
377
378	my $entry = LJ::Entry->new_from_item_hash($ei);
379	next unless $entry;
380
381	# event result data structure
382	my %h = ();
383
384	# Add more data for public posts
385	foreach my $method (@attrs) {
386	$h{$method} = $entry->$method;
387	}
388
389	$h{event_raw} = LJ::trim_widgets(
390	length => $req->{trim_widgets},
391	img_length => $req->{widgets_img_length},
392	text => $h{event_raw},
393	read_more => '<a href="' . $entry->url . '"> ...</a>',
394	) if $req->{trim_widgets};
395
396	$h{event_raw} = LJ::convert_lj_tags_to_links(
397	event => $h{event_raw},
398	embed_url => $entry->url,
399	) if $req->{parseljtags};
400
401	#userpic
402	$h{poster_userpic_url} = $h{userpic} && $h{userpic}->url;
403
404	# log time value
405	$h{logtime} = $LJ::EndOfTime - $ei->{rlogtime};
406	$h{do_captcha} = LJ::Talk::Post::require_captcha_test($u, $entry->poster, '', $h{ditemid})?1:0;
407
408	push @res, \%h;
409
410	push @uids, $h{posterid}, $h{journalid};
411	}
412
413	my $users = LJ::load_userids(@uids);
414
415	foreach (@res) {
416	$_->{journalname} = $users->{ $_->{journalid} }->{'user'};
417	$_->{journaltype} = $users->{ $_->{journalid} }->{'journaltype'};
418	$_->{journalurl} = $users->{ $_->{journalid} }->journal_base;
419	delete $_->{journalid};
420	$_->{postername} = $users->{ $_->{posterid} }->{'user'};
421	$_->{postertype} = $users->{ $_->{posterid} }->{'journaltype'};
422	$_->{posterurl} = $users->{ $_->{posterid} }->journal_base;
423	delete $_->{posterid};
424	}
425
426	LJ::run_hooks("getfriendspage", { 'userid' => $u->userid, });
427
428	return { entries => [ @res ], skip => $skip };
429	}
430
431	sub getinbox
432	{
433	my ($req, $err, $flags) = @_;
434	return undef unless authenticate($req, $err, $flags);
435	my $u = $flags->{'u'};
436
437	my $itemshow = (defined $req->{itemshow}) ? $req->{itemshow} : 100;
438	return fail($err, 209, "Bad itemshow value") if $itemshow ne int($itemshow ) or $itemshow <= 0 or $itemshow > 100;
439	my $skip = (defined $req->{skip}) ? $req->{skip} : 0;
440	return fail($err, 209, "Bad skip value") if $skip ne int($skip ) or $skip < 0 or $skip > 100;
441
442	# get the user's inbox
443	my $inbox = $u->notification_inbox or return fail($err, 500, "Cannot get user inbox");
444
445	my %type_number = (
446	Befriended => 1,
447	Birthday => 2,
448	CommunityInvite => 3,
449	CommunityJoinApprove => 4,
450	CommunityJoinReject => 5,
451	CommunityJoinRequest => 6,
452	Defriended => 7,
453	InvitedFriendJoins => 8,
454	JournalNewComment => 9,
455	JournalNewEntry => 10,
456	NewUserpic => 11,
457	NewVGift => 12,
458	OfficialPost => 13,
459	PermSale => 14,
460	PollVote => 15,
461	SupOfficialPost => 16,
462	UserExpunged => 17,
463	UserMessageRecvd => 18,
464	UserMessageSent => 19,
465	UserNewComment => 20,
466	UserNewEntry => 21,
467	);
468	my %number_type = reverse %type_number;
469
470	my @notifications;
471
472	my $sync_date;
473	# check lastsync for valid date
474	if ($req->{'lastsync'}) {
475	$sync_date = int $req->{'lastsync'};
476	if($sync_date <= 0) {
477	return fail($err,203,"Invalid syncitems date format (must be unixtime)");
478	}
479	}
480
481	if ($req->{gettype}) {
482	$req->{gettype} = [$req->{gettype}] unless ref($req->{gettype});
483
484	my %filter;
485	$filter{"LJ::Event::" . $number_type{$_}} = 1 for @{$req->{gettype}};
486	@notifications = grep { exists $filter{$_->event->class} } $inbox->items;
487
488	} else {
489	@notifications = $inbox->all_items;
490	}
491
492	# By default, notifications are sorted as "oldest are the first"
493	# Reverse it by "newest are the first"
494	@notifications = reverse @notifications;
495
496	if (my $before = $req->{'before'}) {
497	return fail($err,203,"Invalid syncitems date format (must be unixtime)") if $before <= 0;
498	@notifications = grep {$_->when_unixtime <= $before} @notifications;
499	}
500
501	$itemshow = scalar @notifications - $skip if scalar @notifications < $skip + $itemshow;
502
503	my @res;
504	foreach my $item (@notifications[$skip .. $itemshow + $skip - 1]) {
505	next if $sync_date && $item->when_unixtime < $sync_date;
506
507	my $raw = $item->event->raw_info($u, {extended => $req->{extended}});
508
509	my $type_index = $type_number{$raw->{type}};
510	if (defined $type_index) {
511	$raw->{type} = $type_index;
512	} else {
513	$raw->{typename} = $raw->{type};
514	$raw->{type} = 0;
515	}
516
517	$raw->{state} = $item->{state};
518
519	push @res, { %$raw,
520	when => $item->when_unixtime,
521	qid => $item->qid,
522	};
523	}
524
525	return { 'skip' => $skip,
526	'items' => \@res,
527	'login' => $u->user,
528	'journaltype' => $u->journaltype };
529	}
530
531	sub setmessageread {
532	my ($req, $err, $flags) = @_;
533
534	return undef unless authenticate($req, $err, $flags);
535
536	my $u = $flags->{'u'};
537
538	# get the user's inbox
539	my $inbox = $u->notification_inbox or return fail($err, 500, "Cannot get user inbox");
540	my @result;
541
542	# passing requested ids for loading
543	my @notifications = $inbox->all_items;
544
545	# Try to select messages by qid if specified
546	my @qids = @{$req->{qid}};
547	if (scalar @qids) {
548	foreach my $qid (@qids) {
549	my $item = eval {LJ::NotificationItem->new($u, $qid)};
550	$item->mark_read if $item;
551	push @result, { qid => $qid, result => 'set read' };
552	}
553	} else { # Else select it by msgid for back compatibility
554	# make hash of requested message ids
555	my %requested_items = map { $_ => 1 } @{$req->{messageid}};
556
557	# proccessing only requested ids
558	foreach my $item (@notifications) {
559	my $msgid = $item->event->raw_info($u)->{msgid};
560	next unless $requested_items{$msgid};
561	# if message already read -
562	if ($item->{state} eq 'R') {
563	push @result, { msgid => $msgid, result => 'already red' };
564	next;
565	}
566	# in state no 'R' - marking as red
567	$item->mark_read;
568	push @result, { msgid => $msgid, result => 'set read' };
569	}
570	}
571
572	return {
573	result => \@result
574	};
575
576	}
577
578	sub sendmessage
579	{
580	my ($req, $err, $flags) = @_;
581
582	return fail($err, 315) if $LJ::DISABLED{user_messaging};
583
584	return undef unless authenticate($req, $err, $flags);
585	my $u = $flags->{'u'};
586
587	return fail($err, 305) if $u->statusvis eq 'S'; # suspended cannot send private messages
588
589	my $msg_limit = LJ::get_cap($u, "usermessage_length");
590
591	my @errors;
592
593	my $subject_text = LJ::strip_html($req->{'subject'});
594	return fail($err, 208, 'subject')
595	unless LJ::text_in($subject_text);
596
597	# strip HTML from body and test encoding and length
598	my $body_text = LJ::strip_html($req->{'body'});
599	return fail($err, 208, 'body')
600	unless LJ::text_in($body_text);
601
602	my ($msg_len_b, $msg_len_c) = LJ::text_length($body_text);
603	return fail($err, 212, 'found: ' . LJ::commafy($msg_len_c) . ' characters, it should not exceed ' . LJ::commafy($msg_limit))
604	unless ($msg_len_c <= $msg_limit);
605
606
607	return fail($err, 213, 'found: ' . LJ::commafy($msg_len_c) . ' characters, it should exceed zero')
608	if ($msg_len_c <= 0);
609
610	my @to = (ref $req->{'to'}) ? @{$req->{'to'}} : ($req->{'to'});
611	return fail($err, 200) unless scalar @to;
612
613	# remove duplicates
614	my %to = map { lc($_), 1 } @to;
615	@to = keys %to;
616
617	my @msg;
618	BML::set_language('en'); # FIXME
619
620	foreach my $to (@to) {
621	my $tou = LJ::load_user($to);
622	return fail($err, 100, $to)
623	unless $tou;
624
625	my $msg = LJ::Message->new({
626	journalid => $u->userid,
627	otherid => $tou->userid,
628	subject => $subject_text,
629	body => $body_text,
630	parent_msgid => defined $req->{'parent'} ? $req->{'parent'} + 0 : undef,
631	userpic => $req->{'userpic'} \|\| undef,
632	});
633
634	push @msg, $msg
635	if $msg->can_send(\@errors);
636	}
637	return fail($err, 203, join('; ', @errors))
638	if scalar @errors;
639
640	foreach my $msg (@msg) {
641	$msg->send(\@errors);
642	}
643
644	return { 'sent_count' => scalar @msg, 'msgid' => [ grep { $_ } map { $_->msgid } @msg ],
645	(@errors ? ('last_errors' => \@errors) : () ),
646	};
647	}
648
649	sub login
650	{
651	my ($req, $err, $flags) = @_;
652	return undef unless authenticate($req, $err, $flags);
653
654	my $u = $flags->{'u'};
655	my $res = {};
656	my $ver = $req->{'ver'};
657
658	## check for version mismatches
659	## non-Unicode installations can't handle versions >=1
660
661	return fail($err,207, "This installation does not support Unicode clients")
662	if $ver>=1 and not $LJ::UNICODE;
663
664	# do not let locked people log in
665	return fail($err, 308) if $u->{statusvis} eq 'L';
666
667	## return a message to the client to be displayed (optional)
668	login_message($req, $res, $flags);
669	LJ::text_out(\$res->{'message'}) if $ver>=1 and defined $res->{'message'};
670
671	## report what shared journals this user may post in
672	$res->{'usejournals'} = list_usejournals($u);
673
674	## return their friend groups
675	$res->{'friendgroups'} = list_friendgroups($u);
676	return fail($err, 502, "Error loading friend groups") unless $res->{'friendgroups'};
677	if ($ver >= 1) {
678	foreach (@{$res->{'friendgroups'}}) {
679	LJ::text_out(\$_->{'name'});
680	}
681	}
682
683	## if they gave us a number of moods to get higher than, then return them
684	if (defined $req->{'getmoods'}) {
685	$res->{'moods'} = list_moods($req->{'getmoods'});
686	if ($ver >= 1) {
687	# currently all moods are in English, but this might change
688	foreach (@{$res->{'moods'}}) { LJ::text_out(\$_->{'name'}) }
689	}
690	}
691
692	### picture keywords, if they asked for them.
693	if ($req->{'getpickws'} \|\| $req->{'getpickwurls'}) {
694	my $pickws = list_pickws($u);
695	@$pickws = sort { lc($a->[0]) cmp lc($b->[0]) } @$pickws;
696	$res->{'pickws'} = [ map { $_->[0] } @$pickws ] if $req->{'getpickws'};
697	if ($req->{'getpickwurls'}) {
698	if ($u->{'defaultpicid'}) {
699	$res->{'defaultpicurl'} = "$LJ::USERPIC_ROOT/$u->{'defaultpicid'}/$u->{'userid'}";
700	}
701	$res->{'pickwurls'} = [ map {
702	"$LJ::USERPIC_ROOT/$_->[1]/$u->{'userid'}"
703	} @$pickws ];
704	}
705	if ($ver >= 1) {
706	# validate all text
707	foreach(@{$res->{'pickws'}}) { LJ::text_out(\$_); }
708	foreach(@{$res->{'pickwurls'}}) { LJ::text_out(\$_); }
709	LJ::text_out(\$res->{'defaultpicurl'});
710	}
711	}
712	## return caps, if they asked for them
713	if ($req->{'getcaps'}) {
714	$res->{'caps'} = $u->caps;
715	}
716
717	## return client menu tree, if requested
718	if ($req->{'getmenus'}) {
719	$res->{'menus'} = hash_menus($u);
720	if ($ver >= 1) {
721	# validate all text, just in case, even though currently
722	# it's all English
723	foreach (@{$res->{'menus'}}) {
724	LJ::text_out(\$_->{'text'});
725	LJ::text_out(\$_->{'url'}); # should be redundant
726	}
727	}
728	}
729
730	## tell some users they can hit the fast servers later.
731	$res->{'fastserver'} = 1 if LJ::get_cap($u, "fastserver");
732
733	## user info
734	$res->{'userid'} = $u->{'userid'};
735	$res->{'fullname'} = $u->{'name'};
736	LJ::text_out(\$res->{'fullname'}) if $ver >= 1;
737
738	if ($req->{'clientversion'} =~ /^\S+\/\S+$/) {
739	eval {
740	LJ::Request->notes("clientver", $req->{'clientversion'});
741	};
742	}
743
744	## update or add to clientusage table
745	if ($req->{'clientversion'} =~ /^\S+\/\S+$/ &&
746	! $LJ::DISABLED{'clientversionlog'})
747	{
748	my $client = $req->{'clientversion'};
749
750	return fail($err, 208, "Bad clientversion string")
751	if $ver >= 1 and not LJ::text_in($client);
752
753	my $dbh = LJ::get_db_writer();
754	my $qclient = $dbh->quote($client);
755	my $cu_sql = "REPLACE INTO clientusage (userid, clientid, lastlogin) " .
756	"SELECT $u->{'userid'}, clientid, NOW() FROM clients WHERE client=$qclient";
757	my $sth = $dbh->prepare($cu_sql);
758	$sth->execute;
759	unless ($sth->rows) {
760	# only way this can be 0 is if client doesn't exist in clients table, so
761	# we need to add a new row there, to get a new clientid for this new client:
762	$dbh->do("INSERT INTO clients (client) VALUES ($qclient)");
763	# and now we can do the query from before and it should work:
764	$sth = $dbh->prepare($cu_sql);
765	$sth->execute;
766	}
767	}
768
769	return $res;
770	}
771
772	sub getfriendgroups
773	{
774	my ($req, $err, $flags) = @_;
775	return undef unless authenticate($req, $err, $flags);
776	my $u = $flags->{'u'};
777	my $res = {};
778	$res->{'friendgroups'} = list_friendgroups($u);
779	return fail($err, 502, "Error loading friend groups") unless $res->{'friendgroups'};
780	if ($req->{'ver'} >= 1) {
781	foreach (@{$res->{'friendgroups'} \|\| []}) {
782	LJ::text_out(\$_->{'name'});
783	}
784	}
785	return $res;
786	}
787
788	sub getusertags
789	{
790	my ($req, $err, $flags) = @_;
791	return undef unless authenticate($req, $err, $flags);
792	return undef unless check_altusage($req, $err, $flags);
793
794	my $u = $flags->{'u'};
795	my $uowner = $flags->{'u_owner'} \|\| $u;
796	return fail($req, 502) unless $u && $uowner;
797
798	my $tags = LJ::Tags::get_usertags($uowner, { remote => $u });
799	return { tags => [ values %$tags ] };
800	}
801
802	sub getfriends
803	{
804	my ($req, $err, $flags) = @_;
805	return undef unless authenticate($req, $err, $flags);
806	return fail($req,502) unless LJ::get_db_reader();
807	my $u = $flags->{'u'};
808	my $res = {};
809	if ($req->{'includegroups'}) {
810	$res->{'friendgroups'} = list_friendgroups($u);
811	return fail($err, 502, "Error loading friend groups") unless $res->{'friendgroups'};
812	if ($req->{'ver'} >= 1) {
813	foreach (@{$res->{'friendgroups'} \|\| []}) {
814	LJ::text_out(\$_->{'name'});
815	}
816	}
817	}
818	# TAG:FR:protocol:getfriends_of
819	if ($req->{'includefriendof'}) {
820	$res->{'friendofs'} = list_friends($u, {
821	'limit' => $req->{'friendoflimit'},
822	'friendof' => 1,
823	});
824	if ($req->{'ver'} >= 1) {
825	foreach(@{$res->{'friendofs'}}) { LJ::text_out(\$_->{'fullname'}) };
826	}
827	}
828	# TAG:FR:protocol:getfriends
829	$res->{'friends'} = list_friends($u, {
830	'limit' => $req->{'friendlimit'},
831	'includebdays' => $req->{'includebdays'},
832	});
833	if ($req->{'ver'} >= 1) {
834	foreach(@{$res->{'friends'}}) { LJ::text_out(\$_->{'fullname'}) };
835	}
836	return $res;
837	}
838
839	sub friendof
840	{
841	my ($req, $err, $flags) = @_;
842	return undef unless authenticate($req, $err, $flags);
843	return fail($req,502) unless LJ::get_db_reader();
844	my $u = $flags->{'u'};
845	my $res = {};
846
847	# TAG:FR:protocol:getfriends_of2 (same as TAG:FR:protocol:getfriends_of)
848	$res->{'friendofs'} = list_friends($u, {
849	'friendof' => 1,
850	'limit' => $req->{'friendoflimit'},
851	});
852	if ($req->{'ver'} >= 1) {
853	foreach(@{$res->{'friendofs'}}) { LJ::text_out(\$_->{'fullname'}) };
854	}
855	return $res;
856	}
857
858	sub checkfriends
859	{
860	my ($req, $err, $flags) = @_;
861	return undef unless authenticate($req, $err, $flags);
862	my $u = $flags->{'u'};
863	my $res = {};
864
865	# return immediately if they can't use this mode
866	unless (LJ::get_cap($u, "checkfriends")) {
867	$res->{'new'} = 0;
868	$res->{'interval'} = 36000; # tell client to bugger off
869	return $res;
870	}
871
872	## have a valid date?
873	my $lastupdate = $req->{'lastupdate'};
874	if ($lastupdate) {
875	return fail($err,203) unless
876	($lastupdate =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
877	} else {
878	$lastupdate = "0000-00-00 00:00:00";
879	}
880
881	my $interval = LJ::get_cap_min($u, "checkfriends_interval");
882	$res->{'interval'} = $interval;
883
884	my $mask;
885	if ($req->{'mask'} and $req->{'mask'} !~ /\D/) {
886	$mask = $req->{'mask'};
887	}
888
889	my $memkey = [$u->{'userid'},"checkfriends:$u->{userid}:$mask"];
890	my $update = LJ::MemCache::get($memkey);
891	unless ($update) {
892	# TAG:FR:protocol:checkfriends (wants reading list of mask, not "friends")
893	my $fr = LJ::get_friends($u, $mask);
894	unless ($fr && %$fr) {
895	$res->{'new'} = 0;
896	$res->{'lastupdate'} = $lastupdate;
897	return $res;
898	}
899	if (@LJ::MEMCACHE_SERVERS) {
900	my $tu = LJ::get_timeupdate_multi({ memcache_only => 1 }, keys %$fr);
901	my $max = 0;
902	while ($_ = each %$tu) {
903	$max = $tu->{$_} if $tu->{$_} > $max;
904	}
905	$update = LJ::mysql_time($max) if $max;
906	} else {
907	my $dbr = LJ::get_db_reader();
908	unless ($dbr) {
909	# rather than return a 502 no-db error, just say no updates,
910	# because problem'll be fixed soon enough by db admins
911	$res->{'new'} = 0;
912	$res->{'lastupdate'} = $lastupdate;
913	return $res;
914	}
915	my $list = join(", ", map { int($_) } keys %$fr);
916	if ($list) {
917	my $sql = "SELECT MAX(timeupdate) FROM userusage ".
918	"WHERE userid IN ($list)";
919	$update = $dbr->selectrow_array($sql);
920	}
921	}
922	LJ::MemCache::set($memkey,$update,time()+$interval) if $update;
923	}
924	$update \|\|= "0000-00-00 00:00:00";
925
926	if ($req->{'lastupdate'} && $update gt $lastupdate) {
927	$res->{'new'} = 1;
928	} else {
929	$res->{'new'} = 0;
930	}
931
932	$res->{'lastupdate'} = $update;
933	return $res;
934	}
935
936	sub getdaycounts
937	{
938	my ($req, $err, $flags) = @_;
939	return undef unless authenticate($req, $err, $flags);
940	return undef unless check_altusage($req, $err, $flags);
941
942	my $u = $flags->{'u'};
943	my $uowner = $flags->{'u_owner'} \|\| $u;
944	my $ownerid = $flags->{'ownerid'};
945
946	my $res = {};
947	my $daycts = LJ::get_daycounts($uowner, $u);
948	return fail($err,502) unless $daycts;
949
950	foreach my $day (@$daycts) {
951	my $date = sprintf("%04d-%02d-%02d", $day->[0], $day->[1], $day->[2]);
952	push @{$res->{'daycounts'}}, { 'date' => $date, 'count' => $day->[3] };
953	}
954	return $res;
955	}
956
957	sub common_event_validation
958	{
959	my ($req, $err, $flags) = @_;
960
961	# clean up event whitespace
962	# remove surrounding whitespace
963	$req->{event} =~ s/^\s+//;
964	$req->{event} =~ s/\s+$//;
965
966	# convert line endings to unix format
967	if ($req->{'lineendings'} eq "mac") {
968	$req->{event} =~ s/\r/\n/g;
969	} else {
970	$req->{event} =~ s/\r//g;
971	}
972
973	# date validation
974	if ($req->{'year'} !~ /^\d\d\d\d$/ \|\|
975	$req->{'year'} < 1970 \|\| # before unix time started = bad
976	$req->{'year'} > 2037) # after unix time ends = worse! :)
977	{
978	return fail($err,203,"Invalid year value.");
979	}
980	if ($req->{'mon'} !~ /^\d{1,2}$/ \|\|
981	$req->{'mon'} < 1 \|\|
982	$req->{'mon'} > 12)
983	{
984	return fail($err,203,"Invalid month value.");
985	}
986	if ($req->{'day'} !~ /^\d{1,2}$/ \|\| $req->{'day'} < 1 \|\|
987	$req->{'day'} > LJ::days_in_month($req->{'mon'},
988	$req->{'year'}))
989	{
990	return fail($err,203,"Invalid day of month value.");
991	}
992	if ($req->{'hour'} !~ /^\d{1,2}$/ \|\|
993	$req->{'hour'} < 0 \|\| $req->{'hour'} > 23)
994	{
995	return fail($err,203,"Invalid hour value.");
996	}
997	if ($req->{'min'} !~ /^\d{1,2}$/ \|\|
998	$req->{'min'} < 0 \|\| $req->{'min'} > 59)
999	{
1000	return fail($err,203,"Invalid minute value.");
1001	}
1002
1003	# column width
1004	# we only trim Unicode data
1005
1006	if ($req->{'ver'} >=1 ) {
1007	$req->{'subject'} = LJ::text_trim($req->{'subject'}, LJ::BMAX_SUBJECT, LJ::CMAX_SUBJECT);
1008	$req->{'event'} = LJ::text_trim($req->{'event'}, LJ::BMAX_EVENT, LJ::CMAX_EVENT);
1009	foreach (keys %{$req->{'props'}}) {
1010	# do not trim this property, as it's magical and handled later
1011	next if $_ eq 'taglist';
1012
1013	# Allow syn_links and syn_ids the full width of the prop, to avoid truncating long URLS
1014	if ($_ eq 'syn_link' \|\| $_ eq 'syn_id') {
1015	$req->{'props'}->{$_} = LJ::text_trim($req->{'props'}->{$_}, LJ::BMAX_PROP);
1016	} else {
1017	$req->{'props'}->{$_} = LJ::text_trim($req->{'props'}->{$_}, LJ::BMAX_PROP, LJ::CMAX_PROP);
1018	}
1019
1020	}
1021	}
1022
1023	# setup non-user meta-data. it's important we define this here to
1024	# 0. if it's not defined at all, then an editevent where a user
1025	# removes random 8bit data won't remove the metadata. not that
1026	# that matters much. but having this here won't hurt. false
1027	# meta-data isn't saved anyway. so the only point of this next
1028	# line is making the metadata be deleted on edit.
1029	$req->{'props'}->{'unknown8bit'} = 0;
1030
1031	# we don't want attackers sending something that looks like gzipped data
1032	# in protocol version 0 (unknown8bit allowed), otherwise they might
1033	# inject a 100MB string of single letters in a few bytes.
1034	return fail($err,208,"Cannot send gzipped data")
1035	if substr($req->{'event'},0,2) eq "\037\213";
1036
1037	# non-ASCII?
1038	unless ( $flags->{'use_old_content'} \|\| (
1039	LJ::is_ascii($req->{'event'}) &&
1040	LJ::is_ascii($req->{'subject'}) &&
1041	LJ::is_ascii(join(' ', values %{$req->{'props'}})) ))
1042	{
1043
1044	if ($req->{'ver'} < 1) { # client doesn't support Unicode
1045	## Hack: some old clients do send valid UTF-8 data,
1046	## but don't tell us about that.
1047	## Check, if the event/subject are valid UTF-8 strings.
1048	my $tmp_event = $req->{'event'};
1049	my $tmp_subject = $req->{'subject'};
1050	Encode::from_to($tmp_event, "utf-8", "utf-8");
1051	Encode::from_to($tmp_subject, "utf-8", "utf-8");
1052	if ($tmp_event eq $req->{'event'} && $tmp_subject eq $req->{'subject'}) {
1053	## ok, this looks like valid UTF-8
1054	} else {
1055	## encoding is unknown - it's neither ASCII nor UTF-8
1056	# only people should have unknown8bit entries.
1057	my $uowner = $flags->{u_owner} \|\| $flags->{u};
1058	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/.')
1059	if $uowner->{journaltype} ne 'P';
1060
1061	# so rest of site can change chars to ? marks until
1062	# default user's encoding is set. (legacy support)
1063	$req->{'props'}->{'unknown8bit'} = 1;
1064	}
1065	} else {
1066	return fail($err,207, "This installation does not support Unicode clients") unless $LJ::UNICODE;
1067	# validate that the text is valid UTF-8
1068	if (!LJ::text_in($req->{'subject'}) \|\|
1069	!LJ::text_in($req->{'event'}) \|\|
1070	grep { !LJ::text_in($_) } values %{$req->{'props'}}) {
1071	return fail($err, 208, "The text entered is not a valid UTF-8 stream");
1072	}
1073	}
1074	}
1075
1076	## handle meta-data (properties)
1077	LJ::load_props("log");
1078	foreach my $pname (keys %{$req->{'props'}})
1079	{
1080	my $p = LJ::get_prop("log", $pname);
1081
1082	# does the property even exist?
1083	unless ($p) {
1084	$pname =~ s/[^\w]//g;
1085	return fail($err,205,$pname);
1086	}
1087
1088	# don't validate its type if it's 0 or undef (deleting)
1089	next unless ($req->{'props'}->{$pname});
1090
1091	my $ptype = $p->{'datatype'};
1092	my $val = $req->{'props'}->{$pname};
1093
1094	if ($ptype eq "bool" && $val !~ /^[01]$/) {
1095	return fail($err,204,"Property \"$pname\" should be 0 or 1");
1096	}
1097	if ($ptype eq "num" && $val =~ /[^\d]/) {
1098	return fail($err,204,"Property \"$pname\" should be numeric");
1099	}
1100	if ($pname eq "current_coords" && ! eval { LJ::Location->new(coords => $val) }) {
1101	return fail($err,204,"Property \"current_coords\" has invalid value");
1102	}
1103	}
1104
1105	# check props for inactive userpic
1106	if (my $pickwd = $req->{'props'}->{'picture_keyword'}) {
1107	my $pic = LJ::get_pic_from_keyword($flags->{'u'}, $pickwd);
1108
1109	# need to make sure they aren't trying to post with an inactive keyword, but also
1110	# we don't want to allow them to post with a keyword that has no pic at all to prevent
1111	# them from deleting the keyword, posting, then adding it back with editpics.bml
1112	delete $req->{'props'}->{'picture_keyword'} if ! $pic \|\| $pic->{'state'} eq 'I';
1113	}
1114
1115	# validate incoming list of tags
1116	return fail($err, 211)
1117	if $req->{props}->{taglist} &&
1118	! LJ::Tags::is_valid_tagstring($req->{props}->{taglist});
1119
1120	return 1;
1121	}
1122
1123	sub postevent
1124	{
1125	my ($req, $err, $flags) = @_;
1126	un_utf8_request($req);
1127
1128	my $post_noauth = LJ::run_hook('post_noauth', $req);
1129	return undef unless $post_noauth \|\| authenticate($req, $err, $flags);
1130
1131	my $spam = 0;
1132	LJ::run_hook('spam_detector', $req, \$spam);
1133	return fail($err,320) if $spam;
1134
1135	# if going through mod queue, then we know they're permitted to post at least this entry
1136	$flags->{'usejournal_okay'} = 1 if $post_noauth;
1137	return undef unless check_altusage($req, $err, $flags) \|\| $flags->{nomod};
1138
1139	my $u = $flags->{'u'};
1140	my $ownerid = $flags->{'ownerid'}+0;
1141	my $uowner = $flags->{'u_owner'} \|\| $u;
1142	# Make sure we have a real user object here
1143	$uowner = LJ::want_user($uowner) unless LJ::isu($uowner);
1144	my $clusterid = $uowner->{'clusterid'};
1145
1146	my $dbh = LJ::get_db_writer();
1147	my $dbcm = LJ::get_cluster_master($uowner);
1148
1149	return fail($err,306) unless $dbh && $dbcm && $uowner->writer;
1150	return fail($err,200) unless $req->{'event'} =~ /\S/;
1151
1152	### make sure community, shared, or news journals don't post
1153	### note: shared and news journals are deprecated. every shared journal
1154	## should one day be a community journal, of some form.
1155	return fail($err,150) if ($u->{'journaltype'} eq "C" \|\|
1156	$u->{'journaltype'} eq "S" \|\|
1157	$u->{'journaltype'} eq "I" \|\|
1158	$u->{'journaltype'} eq "N");
1159
1160	# underage users can't do this
1161	return fail($err,310) if $u->underage;
1162
1163	# suspended users can't post
1164	return fail($err,305) if ($u->{'statusvis'} eq "S");
1165
1166	# memorials can't post
1167	return fail($err,309) if $u->{statusvis} eq 'M';
1168
1169	# locked accounts can't post
1170	return fail($err,308) if $u->{statusvis} eq 'L';
1171
1172	# check the journal's read-only bit
1173	return fail($err,306) if LJ::get_cap($uowner, "readonly");
1174
1175	# is the user allowed to post?
1176	return fail($err,404,$LJ::MSG_NO_POST) unless LJ::get_cap($u, "can_post");
1177
1178	# is the user allowed to post?
1179	return fail($err,410) if LJ::get_cap($u, "disable_can_post");
1180
1181	# read-only accounts can't post
1182	return fail($err,316) if $u->is_readonly;
1183
1184	# read-only accounts can't be posted to
1185	return fail($err,317) if $uowner->is_readonly;
1186
1187	# can't post to deleted/suspended community
1188	return fail($err,307) unless $uowner->{'statusvis'} eq "V";
1189
1190	# user must have a validated email address to post to any journal - including its own,
1191	# except syndicated (rss, 'Y') journals
1192	# unless this is approved from the mod queue (we'll error out initially, but in case they change later)
1193	return fail($err, 155, "You must have an authenticated email address in order to post to another account")
1194	unless $u->{'status'} eq 'A' \|\| $u->{'journaltype'} eq 'Y';
1195
1196	$req->{'event'} =~ s/\r\n/\n/g; # compact new-line endings to more comfort chars count near 65535 limit
1197
1198	# post content too large
1199	# NOTE: requires $req->{event} be binary data, but we've already
1200	# removed the utf-8 flag in the XML-RPC path, and it never gets
1201	# set in the "flat" protocol path.
1202	return fail($err,409) if length($req->{'event'}) >= LJ::BMAX_EVENT;
1203
1204	my $time_was_faked = 0;
1205	my $offset = 0; # assume gmt at first.
1206
1207	if (defined $req->{'tz'}) {
1208	if ($req->{tz} eq 'guess') {
1209	LJ::get_timezone($u, \$offset, \$time_was_faked);
1210	} elsif ($req->{'tz'} =~ /^[+\-]\d\d\d\d$/) {
1211	# FIXME we ought to store this timezone and make use of it somehow.
1212	$offset = $req->{'tz'} / 100.0;
1213	} else {
1214	return fail($err, 203, "Invalid tz");
1215	}
1216	}
1217
1218	if (defined $req->{'tz'} and not grep { defined $req->{$_} } qw(year mon day hour min)) {
1219	my @ltime = gmtime(time() + ($offset*3600));
1220	$req->{'year'} = $ltime[5]+1900;
1221	$req->{'mon'} = $ltime[4]+1;
1222	$req->{'day'} = $ltime[3];
1223	$req->{'hour'} = $ltime[2];
1224	$req->{'min'} = $ltime[1];
1225	$time_was_faked = 1;
1226	}
1227
1228	return undef
1229	unless common_event_validation($req, $err, $flags);
1230
1231	# confirm we can add tags, at least
1232	return fail($err, 312)
1233	if $req->{props} && $req->{props}->{taglist} &&
1234	! LJ::Tags::can_add_tags($uowner, $u);
1235
1236	my $event = $req->{'event'};
1237
1238	### allow for posting to journals that aren't yours (if you have permission)
1239	my $posterid = $u->{'userid'}+0;
1240
1241	# make the proper date format
1242	my $eventtime = sprintf("%04d-%02d-%02d %02d:%02d",
1243	$req->{'year'}, $req->{'mon'},
1244	$req->{'day'}, $req->{'hour'},
1245	$req->{'min'});
1246	my $qeventtime = $dbh->quote($eventtime);
1247
1248	# load userprops all at once
1249	my @poster_props = qw(newesteventtime dupsig_post);
1250	my @owner_props = qw(newpost_minsecurity moderated);
1251	push @owner_props, 'opt_weblogscom' unless $req->{'props'}->{'opt_backdated'};
1252
1253	LJ::load_user_props($u, @poster_props, @owner_props);
1254	if ($uowner->{'userid'} == $u->{'userid'}) {
1255	$uowner->{$_} = $u->{$_} foreach (@owner_props);
1256	} else {
1257	LJ::load_user_props($uowner, @owner_props);
1258	}
1259
1260	# are they trying to post back in time?
1261	if ($posterid == $ownerid && $u->{'journaltype'} ne 'Y' &&
1262	!$time_was_faked && $u->{'newesteventtime'} &&
1263	$eventtime lt $u->{'newesteventtime'} &&
1264	!$req->{'props'}->{'opt_backdated'}) {
1265	return fail($err, 153, "You have an entry which was posted at $u->{'newesteventtime'}, but you're trying to post an entry before this. Please check the date and time of both entries. If the other entry is set in the future on purpose, edit that entry to use the \"Date Out of Order\" option. Otherwise, use the \"Date Out of Order\" option for this entry instead.");
1266	}
1267
1268	my $qallowmask = $req->{'allowmask'}+0;
1269	my $security = "public";
1270	my $uselogsec = 0;
1271	if ($req->{'security'} eq "usemask" \|\| $req->{'security'} eq "private") {
1272	$security = $req->{'security'};
1273	}
1274	if ($req->{'security'} eq "usemask") {
1275	$uselogsec = 1;
1276	}
1277
1278	# can't specify both a custom security and 'friends-only'
1279	return fail($err, 203, "Invalid friends group security set")
1280	if $qallowmask > 1 && $qallowmask % 2;
1281
1282	## if newpost_minsecurity is set, new entries have to be
1283	## a minimum security level
1284	$security = "private"
1285	if $uowner->newpost_minsecurity eq "private";
1286	($security, $qallowmask) = ("usemask", 1)
1287	if $uowner->newpost_minsecurity eq "friends"
1288	and $security eq "public";
1289
1290	my $qsecurity = $dbh->quote($security);
1291
1292	### make sure user can't post with "custom/private security" on shared journals
1293	return fail($err,102)
1294	if ($ownerid != $posterid && # community post
1295	($req->{'security'} eq "private" \|\|
1296	($req->{'security'} eq "usemask" && $qallowmask != 1 )));
1297
1298	# make sure this user isn't banned from posting here (if
1299	# this is a community journal)
1300	return fail($err,151) if
1301	LJ::is_banned($posterid, $ownerid);
1302
1303	# don't allow backdated posts in communities
1304	return fail($err,152) if
1305	($req->{'props'}->{"opt_backdated"} &&
1306	$uowner->{'journaltype'} ne "P");
1307
1308	# do processing of embedded polls (doesn't add to database, just
1309	# does validity checking)
1310	my @polls = ();
1311	if (LJ::Poll->contains_new_poll(\$event))
1312	{
1313	return fail($err,301,"Your account type doesn't permit creating polls.")
1314	unless (LJ::get_cap($u, "makepoll")
1315	\|\| ($uowner->{'journaltype'} eq "C"
1316	&& LJ::get_cap($uowner, "makepoll")
1317	&& LJ::can_manage_other($u, $uowner)));
1318
1319	my $error = "";
1320	@polls = LJ::Poll->new_from_html(\$event, \$error, {
1321	'journalid' => $ownerid,
1322	'posterid' => $posterid,
1323	});
1324	return fail($err,103,$error) if $error;
1325	}
1326
1327	# convert RTE lj-embeds to normal lj-embeds
1328	$event = LJ::EmbedModule->transform_rte_post($event);
1329
1330	# process module embedding
1331	LJ::EmbedModule->parse_module_embed($uowner, \$event);
1332
1333	my $now = $dbcm->selectrow_array("SELECT UNIX_TIMESTAMP()");
1334	my $anum = int(rand(256));
1335
1336	# by default we record the true reverse time that the item was entered.
1337	# however, if backdate is on, we put the reverse time at the end of time
1338	# (which makes it equivalent to 1969, but get_recent_items will never load
1339	# it... where clause there is: < $LJ::EndOfTime). but this way we can
1340	# have entries that don't show up on friends view, now that we don't have
1341	# the hints table to not insert into.
1342	my $rlogtime = $LJ::EndOfTime;
1343	unless ($req->{'props'}->{"opt_backdated"}) {
1344	$rlogtime -= $now;
1345	}
1346
1347	my $dupsig = Digest::MD5::md5_hex(join('', map { $req->{$_} }
1348	qw(subject event usejournal security allowmask)));
1349	my $lock_key = "post-$ownerid";
1350
1351	# release our duplicate lock
1352	my $release = sub { $dbcm->do("SELECT RELEASE_LOCK(?)", undef, $lock_key); };
1353
1354	# our own local version of fail that releases our lock first
1355	my $fail = sub { $release->(); return fail(@_); };
1356
1357	my $res = {};
1358	my $res_done = 0; # set true by getlock when post was duplicate, or error getting lock
1359
1360	my $getlock = sub {
1361	my $r = $dbcm->selectrow_array("SELECT GET_LOCK(?, 2)", undef, $lock_key);
1362	unless ($r) {
1363	$res = undef; # a failure case has an undef result
1364	fail($err,503); # set error flag to "can't get lock";
1365	$res_done = 1; # tell caller to bail out
1366	return;
1367	}
1368	my @parts = split(/:/, $u->{'dupsig_post'});
1369	if ($parts[0] eq $dupsig) {
1370	# duplicate! let's make the client think this was just the
1371	# normal first response.
1372	$res->{'itemid'} = $parts[1];
1373	$res->{'anum'} = $parts[2];
1374
1375	my $dup_entry = LJ::Entry->new($uowner, jitemid => $res->{'itemid'}, anum => $res->{'anum'});
1376	$res->{'url'} = $dup_entry->url;
1377
1378	$res_done = 1;
1379	$release->();
1380	}
1381	};
1382
1383	my $need_moderated = ( $uowner->{'moderated'} =~ /^[1A]$/ ) ? 1 : 0;
1384	if ( $uowner->{'moderated'} eq 'F' ) {
1385	## Scan post for spam
1386	LJ::run_hook('spam_community_detector', $uowner, $req, \$need_moderated);
1387	}
1388	# if posting to a moderated community, store and bail out here
1389	if ($uowner->{'journaltype'} eq 'C' && $need_moderated && !$flags->{'nomod'}) {
1390	# don't moderate admins, moderators & pre-approved users
1391	my $dbh = LJ::get_db_writer();
1392	my $relcount = $dbh->selectrow_array("SELECT COUNT(*) FROM reluser ".
1393	"WHERE userid=$ownerid AND targetid=$posterid ".
1394	"AND type IN ('A','M','N')");
1395	unless ($relcount) {
1396	# moderation queue full?
1397	my $modcount = $dbcm->selectrow_array("SELECT COUNT(*) FROM modlog WHERE journalid=$ownerid");
1398	return fail($err, 407) if $modcount >= LJ::get_cap($uowner, "mod_queue");
1399
1400	$modcount = $dbcm->selectrow_array("SELECT COUNT(*) FROM modlog ".
1401	"WHERE journalid=$ownerid AND posterid=$posterid");
1402	return fail($err, 408) if $modcount >= LJ::get_cap($uowner, "mod_queue_per_poster");
1403
1404	$req->{'_moderate'}->{'authcode'} = LJ::make_auth_code(15);
1405
1406	# create tag <lj-embed> from HTML-tag <embed>
1407	LJ::EmbedModule->parse_module_embed($uowner, \$req->{event});
1408
1409	my $fr = $dbcm->quote(Storable::nfreeze($req));
1410	return fail($err, 409) if length($fr) > 200_000;
1411
1412	# store
1413	my $modid = LJ::alloc_user_counter($uowner, "M");
1414	return fail($err, 501) unless $modid;
1415
1416	$uowner->do("INSERT INTO modlog (journalid, modid, posterid, subject, logtime) ".
1417	"VALUES ($ownerid, $modid, $posterid, ?, NOW())", undef,
1418	LJ::text_trim($req->{'subject'}, 30, 0));
1419	return fail($err, 501) if $uowner->err;
1420
1421	$uowner->do("INSERT INTO modblob (journalid, modid, request_stor) ".
1422	"VALUES ($ownerid, $modid, $fr)");
1423	if ($uowner->err) {
1424	$uowner->do("DELETE FROM modlog WHERE journalid=$ownerid AND modid=$modid");
1425	return fail($err, 501);
1426	}
1427
1428	# alert moderator(s)
1429	my $mods = LJ::load_rel_user($dbh, $ownerid, 'M') \|\| [];
1430	if (@$mods) {
1431	# load up all these mods and figure out if they want email or not
1432	my $modlist = LJ::load_userids(@$mods);
1433
1434	my @emails;
1435	my $ct;
1436	foreach my $mod (values %$modlist) {
1437	last if $ct > 20; # don't send more than 20 emails.
1438
1439	next unless $mod->is_visible;
1440
1441	LJ::load_user_props($mod, 'opt_nomodemail');
1442	next if $mod->{opt_nomodemail};
1443	next if $mod->{status} ne "A";
1444
1445	push @emails,
1446	{
1447	to => $mod->email_raw,
1448	browselang => $mod->prop('browselang'),
1449	charset => $mod->mailencoding \|\| 'utf-8',
1450	};
1451
1452	++$ct;
1453	}
1454
1455	foreach my $to (@emails) {
1456	# TODO: html/plain text.
1457	my $body = LJ::Lang::get_text(
1458	$to->{'browselang'},
1459	'esn.moderated_submission.body', undef,
1460	{
1461	user => $u->{'user'},
1462	subject => $req->{'subject'},
1463	community => $uowner->{'user'},
1464	modid => $modid,
1465	siteroot => $LJ::SITEROOT,
1466	sitename => $LJ::SITENAME,
1467	moderateurl => "$LJ::SITEROOT/community/moderate.bml?authas=$uowner->{'user'}&modid=$modid",
1468	viewurl => "$LJ::SITEROOT/community/moderate.bml?authas=$uowner->{'user'}",
1469	});
1470
1471	my $subject = LJ::Lang::get_text($to->{'browselang'},'esn.moderated_submission.subject');
1472
1473	LJ::send_mail({
1474	'to' => $to->{to},
1475	'from' => $LJ::ADMIN_EMAIL,
1476	'charset' => $to->{charset},
1477	'subject' => $subject,
1478	'body' => $body,
1479	});
1480	}
1481	}
1482
1483	my $msg = translate($u, "modpost", undef);
1484	return { 'message' => $msg };
1485	}
1486	} # /moderated comms
1487
1488	# posting:
1489
1490	$getlock->(); return $res if $res_done;
1491
1492	# do rate-checking
1493	if ($u->{'journaltype'} ne "Y" && ! LJ::rate_log($u, "post", 1)) {
1494	return $fail->($err,405);
1495	}
1496
1497	my $jitemid = LJ::alloc_user_counter($uowner, "L");
1498	return $fail->($err,501,"No itemid could be generated.") unless $jitemid;
1499
1500	# bring in LJ::Entry with Class::Autouse
1501	LJ::Entry->can("dostuff");
1502	LJ::replycount_do($uowner, $jitemid, "init");
1503
1504	# remove comments and logprops on new entry ... see comment by this sub for clarification
1505	LJ::Protocol::new_entry_cleanup_hack($u, $jitemid) if $LJ::NEW_ENTRY_CLEANUP_HACK;
1506	my $verb = $LJ::NEW_ENTRY_CLEANUP_HACK ? 'REPLACE' : 'INSERT';
1507
1508	my $dberr;
1509	$uowner->log2_do(\$dberr, "INSERT INTO log2 (journalid, jitemid, posterid, eventtime, logtime, security, ".
1510	"allowmask, replycount, year, month, day, revttime, rlogtime, anum) ".
1511	"VALUES ($ownerid, $jitemid, $posterid, $qeventtime, FROM_UNIXTIME($now), $qsecurity, $qallowmask, ".
1512	"0, $req->{'year'}, $req->{'mon'}, $req->{'day'}, $LJ::EndOfTime-".
1513	"UNIX_TIMESTAMP($qeventtime), $rlogtime, $anum)");
1514	return $fail->($err,501,$dberr) if $dberr;
1515
1516	LJ::MemCache::incr([$ownerid, "log2ct:$ownerid"]);
1517	LJ::memcache_kill($ownerid, "dayct2");
1518
1519	# set userprops.
1520	{
1521	my %set_userprop;
1522
1523	# keep track of itemid/anum for later potential duplicates
1524	$set_userprop{"dupsig_post"} = "$dupsig:$jitemid:$anum";
1525
1526	# record the eventtime of the last update (for own journals only)
1527	$set_userprop{"newesteventtime"} = $eventtime
1528	if $posterid == $ownerid and not $req->{'props'}->{'opt_backdated'} and not $time_was_faked;
1529
1530	LJ::set_userprop($u, \%set_userprop);
1531	}
1532
1533	# end duplicate locking section
1534	$release->();
1535
1536	my $ditemid = $jitemid * 256 + $anum;
1537
1538	### finish embedding stuff now that we have the itemid
1539	{
1540	### this should NOT return an error, and we're mildly fucked by now
1541	### if it does (would have to delete the log row up there), so we're
1542	### not going to check it for now.
1543
1544	my $error = "";
1545	foreach my $poll (@polls) {
1546	$poll->save_to_db(
1547	journalid => $ownerid,
1548	posterid => $posterid,
1549	ditemid => $ditemid,
1550	error => \$error,
1551	);
1552
1553	my $pollid = $poll->pollid;
1554
1555	$event =~ s/<lj-poll-placeholder>/<lj-poll-$pollid>/;
1556	}
1557	}
1558	#### /embedding
1559
1560	### extract links for meme tracking
1561	unless ($req->{'security'} eq "usemask" \|\|
1562	$req->{'security'} eq "private")
1563	{
1564	foreach my $url (LJ::get_urls($event)) {
1565	LJ::record_meme($url, $posterid, $ditemid, $ownerid);
1566	}
1567	}
1568
1569	# record journal's disk usage
1570	my $bytes = length($event) + length($req->{'subject'});
1571	$uowner->dudata_set('L', $jitemid, $bytes);
1572
1573	$uowner->do("$verb INTO logtext2 (journalid, jitemid, subject, event) ".
1574	"VALUES ($ownerid, $jitemid, ?, ?)", undef, $req->{'subject'},
1575	LJ::text_compress($event));
1576	if ($uowner->err) {
1577	my $msg = $uowner->errstr;
1578	LJ::delete_entry($uowner, $jitemid); # roll-back
1579	return fail($err,501,"logtext:$msg");
1580	}
1581	LJ::MemCache::set([$ownerid,"logtext:$clusterid:$ownerid:$jitemid"],
1582	[ $req->{'subject'}, $event ]);
1583
1584	# keep track of custom security stuff in other table.
1585	if ($uselogsec) {
1586	$uowner->do("INSERT INTO logsec2 (journalid, jitemid, allowmask) ".
1587	"VALUES ($ownerid, $jitemid, $qallowmask)");
1588	if ($uowner->err) {
1589	my $msg = $uowner->errstr;
1590	LJ::delete_entry($uowner, $jitemid); # roll-back
1591	return fail($err,501,"logsec2:$msg");
1592	}
1593	}
1594
1595	# Entry tags
1596	if ($req->{props} && defined $req->{props}->{taglist}) {
1597	# slightly misnamed, the taglist is/was normally a string, but now can also be an arrayref.
1598	my $taginput = $req->{props}->{taglist};
1599
1600	my $logtag_opts = {
1601	remote => $u,
1602	skipped_tags => [], # do all possible and report impossible
1603	};
1604
1605	if (ref $taginput eq 'ARRAY') {
1606	$logtag_opts->{set} = [@$taginput];
1607	$req->{props}->{taglist} = join(", ", @$taginput);
1608	} else {
1609	$logtag_opts->{set_string} = $taginput;
1610	}
1611
1612	my $rv = LJ::Tags::update_logtags($uowner, $jitemid, $logtag_opts);
1613	push @{$res->{warnings} \|\|= []}, LJ::Lang::ml('/update.bml.tags.skipped', { 'tags' => join(', ', @{$logtag_opts->{skipped_tags}}),
1614	'limit' => $uowner->get_cap('tags_max') } )
1615	if @{$logtag_opts->{skipped_tags}};
1616	}
1617
1618	## copyright
1619	if (LJ::is_enabled('default_copyright', $u)) {
1620	$req->{'props'}->{'copyright'} = $u->prop('default_copyright')
1621	unless defined $req->{'props'}->{'copyright'};
1622	$req->{'props'}->{'copyright'} = 'P' # second try
1623	unless defined $req->{'props'}->{'copyright'};
1624	} else {
1625	delete $req->{'props'}->{'copyright'};
1626	}
1627
1628	# meta-data
1629	if (%{$req->{'props'}}) {
1630	my $propset = {};
1631	foreach my $pname (keys %{$req->{'props'}}) {
1632	next unless $req->{'props'}->{$pname};
1633	next if $pname eq "revnum" \|\| $pname eq "revtime";
1634	my $p = LJ::get_prop("log", $pname);
1635	next unless $p;
1636	next unless $req->{'props'}->{$pname};
1637	$propset->{$pname} = $req->{'props'}->{$pname};
1638	}
1639	my %logprops;
1640	LJ::set_logprop($uowner, $jitemid, $propset, \%logprops) if %$propset;
1641
1642	# if set_logprop modified props above, we can set the memcache key
1643	# to be the hashref of modified props, since this is a new post
1644	LJ::MemCache::set([$uowner->{'userid'}, "logprop:$uowner->{'userid'}:$jitemid"],
1645	\%logprops) if %logprops;
1646	}
1647
1648	$dbh->do("UPDATE userusage SET timeupdate=NOW(), lastitemid=$jitemid ".
1649	"WHERE userid=$ownerid") unless $flags->{'notimeupdate'};
1650	LJ::MemCache::set([$ownerid, "tu:$ownerid"], pack("N", time()), 30*60);
1651
1652	# argh, this is all too ugly. need to unify more postpost stuff into async
1653	$u->invalidate_directory_record;
1654
1655	# note this post in recentactions table
1656	LJ::note_recent_action($uowner, 'post');
1657
1658	# if the post was public, and the user has not opted out, try to insert into the random table;
1659	# note we do INSERT INGORE since there will be lots of people posting every second, and that's
1660	# the granularity we use
1661	if ($security eq 'public' && LJ::u_equals($u, $uowner) && ! $u->prop('latest_optout')) {
1662	$u->do("INSERT IGNORE INTO random_user_set (posttime, userid) VALUES (UNIX_TIMESTAMP(), ?)",
1663	undef, $u->{userid});
1664	}
1665
1666	my @jobs; # jobs to add into TheSchwartz
1667
1668	# notify weblogs.com of post if necessary
1669	if (!$LJ::DISABLED{'weblogs_com'} && $u->{'opt_weblogscom'} && LJ::get_cap($u, "weblogscom") &&
1670	$security eq "public" && !$req->{'props'}->{'opt_backdated'}) {
1671	push @jobs, TheSchwartz::Job->new_from_array("LJ::Worker::Ping::WeblogsCom", {
1672	'user' => $u->{'user'},
1673	'title' => $u->{'journaltitle'} \|\| $u->{'name'},
1674	'url' => LJ::journal_base($u) . "/",
1675	});
1676	}
1677
1678	my $entry = LJ::Entry->new($uowner, jitemid => $jitemid, anum => $anum);
1679
1680	# run local site-specific actions
1681	LJ::run_hooks("postpost", {
1682	'itemid' => $jitemid,
1683	'anum' => $anum,
1684	'journal' => $uowner,
1685	'poster' => $u,
1686	'event' => $event,
1687	'eventtime' => $eventtime,
1688	'subject' => $req->{'subject'},
1689	'security' => $security,
1690	'allowmask' => $qallowmask,
1691	'props' => $req->{'props'},
1692	'entry' => $entry,
1693	'jobs' => \@jobs, # for hooks to push jobs onto
1694	'req' => $req,
1695	'res' => $res,
1696	});
1697
1698	# cluster tracking
1699	LJ::mark_user_active($u, 'post');
1700	LJ::mark_user_active($uowner, 'post') unless LJ::u_equals($u, $uowner);
1701
1702	$res->{'itemid'} = $jitemid; # by request of mart
1703	$res->{'anum'} = $anum;
1704	$res->{'url'} = $entry->url;
1705
1706	push @jobs, LJ::Event::JournalNewEntry->new($entry)->fire_job;
1707	push @jobs, LJ::Event::UserNewEntry->new($entry)->fire_job if (!$LJ::DISABLED{'esn-userevents'} \|\| $LJ::_T_FIRE_USERNEWENTRY);
1708	push @jobs, LJ::EventLogRecord::NewEntry->new($entry)->fire_job;
1709
1710	# PubSubHubbub Support
1711	LJ::Feed::generate_hubbub_jobs($uowner, \@jobs) unless $uowner->is_syndicated;
1712
1713	my $sclient = LJ::theschwartz();
1714	if ($sclient && @jobs) {
1715	my @handles = $sclient->insert_jobs(@jobs);
1716	# TODO: error on failure? depends on the job I suppose? property of the job?
1717	}
1718
1719	return $res;
1720	}
1721
1722	sub editevent
1723	{
1724	my ($req, $err, $flags) = @_;
1725	un_utf8_request($req);
1726
1727	return undef unless authenticate($req, $err, $flags);
1728
1729	my $spam = 0;
1730	return undef unless LJ::run_hook('spam_detector', $req, \$spam);
1731	return fail($err,320) if $spam;
1732
1733	# we check later that user owns entry they're modifying, so all
1734	# we care about for check_altusage is that the target journal
1735	# exists, and we want it to setup some data in $flags.
1736	$flags->{'ignorecanuse'} = 1;
1737	return undef unless check_altusage($req, $err, $flags);
1738
1739	my $u = $flags->{'u'};
1740	my $ownerid = $flags->{'ownerid'};
1741	my $uowner = $flags->{'u_owner'} \|\| $u;
1742	# Make sure we have a user object here
1743	$uowner = LJ::want_user($uowner) unless LJ::isu($uowner);
1744	my $clusterid = $uowner->{'clusterid'};
1745	my $posterid = $u->{'userid'};
1746	my $qallowmask = $req->{'allowmask'}+0;
1747	my $sth;
1748
1749	my $itemid = $req->{'itemid'}+0;
1750
1751	# underage users can't do this
1752	return fail($err,310) if $u->underage;
1753
1754	# check the journal's read-only bit
1755	return fail($err,306) if LJ::get_cap($uowner, "readonly");
1756
1757	# can't edit in deleted/suspended community
1758	return fail($err,307) unless $uowner->{'statusvis'} eq "V" \|\| $uowner->is_readonly;
1759
1760	my $dbcm = LJ::get_cluster_master($uowner);
1761	return fail($err,306) unless $dbcm;
1762
1763	# can't specify both a custom security and 'friends-only'
1764	return fail($err, 203, "Invalid friends group security set.")
1765	if $qallowmask > 1 && $qallowmask % 2;
1766
1767	### make sure user can't change a post to "custom/private security" on shared journals
1768	return fail($err,102)
1769	if ($ownerid != $posterid && # community post
1770	($req->{'security'} eq "private" \|\|
1771	($req->{'security'} eq "usemask" && $qallowmask != 1 )));
1772
1773	# make sure the new entry's under the char limit
1774	# NOTE: as in postevent, this requires $req->{event} to be binary data
1775	# but we've already removed the utf-8 flag in the XML-RPC path, and it
1776	# never gets set in the "flat" protocol path
1777	return fail($err,409) if length($req->{event}) >= LJ::BMAX_EVENT;
1778
1779	# fetch the old entry from master database so we know what we
1780	# really have to update later. usually people just edit one part,
1781	# not every field in every table. reads are quicker than writes,
1782	# so this is worth it.
1783	my $oldevent = $dbcm->selectrow_hashref
1784	("SELECT journalid AS 'ownerid', posterid, eventtime, logtime, ".
1785	"compressed, security, allowmask, year, month, day, ".
1786	"rlogtime, anum FROM log2 WHERE journalid=$ownerid AND jitemid=$itemid");
1787
1788	($oldevent->{subject}, $oldevent->{event}) = $dbcm->selectrow_array
1789	("SELECT subject, event FROM logtext2 ".
1790	"WHERE journalid=$ownerid AND jitemid=$itemid");
1791
1792	LJ::text_uncompress(\$oldevent->{'event'});
1793
1794	# use_old_content indicates the subject and entry are not changing
1795	if ($flags->{'use_old_content'}) {
1796	$req->{'event'} = $oldevent->{event};
1797	$req->{'subject'} = $oldevent->{subject};
1798	}
1799
1800	# kill seconds in eventtime, since we don't use it, then we can use 'eq' and such
1801	$oldevent->{'eventtime'} =~ s/:00$//;
1802
1803	### make sure this user is allowed to edit this entry
1804	return fail($err,302)
1805	unless ($ownerid == $oldevent->{'ownerid'});
1806
1807	### what can they do to somebody elses entry? (in shared journal)
1808	### can edit it if they own or maintain the journal, but not if the journal is read-only
1809	if ($posterid != $oldevent->{'posterid'} \|\| $u->is_readonly \|\| $uowner->is_readonly)
1810	{
1811	## deleting.
1812	return fail($err,304)
1813	if ($req->{'event'} !~ /\S/ && !
1814	($ownerid == $u->{'userid'} \|\|
1815	# community account can delete it (ick)
1816
1817	LJ::can_manage_other($posterid, $ownerid)
1818	# if user is a community maintainer they can delete
1819	# it too (good)
1820	));
1821
1822	## editing:
1823	if ($req->{'event'} =~ /\S/) {
1824	return fail($err,303) if $posterid != $oldevent->{'posterid'};
1825	return fail($err,318) if $u->is_readonly;
1826	return fail($err,319) if $uowner->is_readonly;
1827	}
1828	}
1829
1830	# simple logic for deleting an entry
1831	if (!$flags->{'use_old_content'} && $req->{'event'} !~ /\S/)
1832	{
1833
1834	## 23.11.2009. Next code added due to some hackers activities
1835	## that use trojans to delete user's entries in theirs journals.
1836	if ($LJ::DELETING_ENTRIES_IS_DISABLED
1837	&& $u->is_person and $u->userid eq $oldevent->{ownerid}
1838	){
1839	my $qsecurity = $uowner->quote('private');
1840	my $dberr;
1841	$uowner->log2_do(\$dberr, "UPDATE log2 SET security=$qsecurity " .
1842	"WHERE journalid=$ownerid AND jitemid=$itemid");
1843	return fail($err,501,$dberr) if $dberr;
1844	return fail($err, 321);
1845	}
1846
1847	# if their newesteventtime prop equals the time of the one they're deleting
1848	# then delete their newesteventtime.
1849	if ($u->{'userid'} == $uowner->{'userid'}) {
1850	LJ::load_user_props($u, { use_master => 1 }, "newesteventtime");
1851	if ($u->{'newesteventtime'} eq $oldevent->{'eventtime'}) {
1852	LJ::set_userprop($u, "newesteventtime", undef);
1853	}
1854	}
1855
1856	# log this event, unless noauth is on, which means it is being done internally and we should
1857	# rely on them to log why they're deleting the entry if they need to. that way we don't have
1858	# double entries, and we have as much information available as possible at the location the
1859	# delete is initiated.
1860	$uowner->log_event('delete_entry', {
1861	remote => $u,
1862	actiontarget => ($req->{itemid} * 256 + $oldevent->{anum}),
1863	method => 'protocol',
1864	})
1865	unless $flags->{noauth};
1866
1867	# We must use property 'dupsig_post' in author of entry to be deleted, not in
1868	# remote user or journal owner!
1869	my $item = LJ::get_log2_row($uowner, $req->{'itemid'});
1870	my $poster = $item ? LJ::want_user($item->{'posterid'}) : '';
1871
1872	LJ::delete_entry($uowner, $req->{'itemid'}, 'quick', $oldevent->{'anum'});
1873
1874	# clear their duplicate protection, so they can later repost
1875	# what they just deleted. (or something... probably rare.)
1876	LJ::set_userprop($poster, "dupsig_post", undef) if $poster;
1877
1878	my $res = { 'itemid' => $itemid,
1879	'anum' => $oldevent->{'anum'} };
1880	return $res;
1881	}
1882
1883	# now make sure the new entry text isn't $CannotBeShown
1884	return fail($err, 210)
1885	if $req->{event} eq $CannotBeShown;
1886
1887	# don't allow backdated posts in communities
1888	return fail($err,152) if
1889	($req->{'props'}->{"opt_backdated"} &&
1890	$uowner->{'journaltype'} ne "P");
1891
1892	# make year/mon/day/hour/min optional in an edit event,
1893	# and just inherit their old values
1894	{
1895	$oldevent->{'eventtime'} =~ /^(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d)/;
1896	$req->{'year'} = $1 unless defined $req->{'year'};
1897	$req->{'mon'} = $2+0 unless defined $req->{'mon'};
1898	$req->{'day'} = $3+0 unless defined $req->{'day'};
1899	$req->{'hour'} = $4+0 unless defined $req->{'hour'};
1900	$req->{'min'} = $5+0 unless defined $req->{'min'};
1901	}
1902
1903	# updating an entry:
1904	return undef
1905	unless common_event_validation($req, $err, $flags);
1906
1907	### load existing meta-data
1908	my %curprops;
1909	LJ::load_log_props2($dbcm, $ownerid, [ $itemid ], \%curprops);
1910
1911	## handle meta-data (properties)
1912	my %props_byname = ();
1913	foreach my $key (keys %{$req->{'props'}}) {
1914	## changing to something else?
1915	if ($curprops{$itemid}->{$key} ne $req->{'props'}->{$key}) {
1916	$props_byname{$key} = $req->{'props'}->{$key};
1917	}
1918	}
1919
1920	my $event = $req->{'event'};
1921	my $owneru = LJ::load_userid($ownerid);
1922	$event = LJ::EmbedModule->transform_rte_post($event);
1923	LJ::EmbedModule->parse_module_embed($owneru, \$event);
1924
1925	my $bytes = length($event) + length($req->{'subject'});
1926
1927	my $eventtime = sprintf("%04d-%02d-%02d %02d:%02d",
1928	map { $req->{$_} } qw(year mon day hour min));
1929	my $qeventtime = $dbcm->quote($eventtime);
1930
1931	# preserve old security by default, use user supplied if it's understood
1932	my $security = $oldevent->{security};
1933	$security = $req->{security}
1934	if $req->{security} &&
1935	$req->{security} =~ /^(?:public\|private\|usemask)$/;
1936
1937	my $do_tags = $req->{props} && defined $req->{props}->{taglist};
1938	if ($oldevent->{security} ne $security \|\| $qallowmask != $oldevent->{allowmask}) {
1939	# FIXME: this is a hopefully temporary hack which deletes tags from the entry
1940	# when the security has changed. the real fix is to make update_logtags aware
1941	# of security changes so it can update logkwsum appropriately.
1942
1943	unless ($do_tags) {
1944	# we need to fix security on this entry's tags, but the user didn't give us a tag list
1945	# to work with, so we have to go get the tags on the entry, and construct a tag list,
1946	# in order to pass to update_logtags down at the bottom of this whole update
1947	my $tags = LJ::Tags::get_logtags($uowner, $itemid);
1948	$tags = $tags->{$itemid};
1949	$req->{props}->{taglist} = join(',', sort values %{$tags \|\| {}});
1950	$do_tags = 1; # bleh, force the update later
1951	}
1952
1953	LJ::Tags::delete_logtags($uowner, $itemid);
1954	}
1955
1956	my $qyear = $req->{'year'}+0;
1957	my $qmonth = $req->{'mon'}+0;
1958	my $qday = $req->{'day'}+0;
1959
1960	if ($eventtime ne $oldevent->{'eventtime'} \|\|
1961	$security ne $oldevent->{'security'} \|\|
1962	(!$curprops{$itemid}->{opt_backdated} && $req->{props}{opt_backdated}) \|\|
1963	$qallowmask != $oldevent->{'allowmask'})
1964	{
1965	# are they changing their most recent post?
1966	LJ::load_user_props($u, "newesteventtime");
1967	if ($u->{userid} == $uowner->{userid} &&
1968	$u->{newesteventtime} eq $oldevent->{eventtime}) {
1969	# did they change the time?
1970	if ($eventtime ne $oldevent->{eventtime}) {
1971	# the newesteventtime is this event's new time.
1972	LJ::set_userprop($u, "newesteventtime", $eventtime);
1973	} elsif (!$curprops{$itemid}->{opt_backdated} && $req->{props}{opt_backdated}) {
1974	# otherwise, if they set the backdated flag,
1975	# then we no longer know the newesteventtime.
1976	LJ::set_userprop($u, "newesteventtime", undef);
1977	}
1978	}
1979
1980	my $qsecurity = $uowner->quote($security);
1981	my $dberr;
1982	$uowner->log2_do(\$dberr, "UPDATE log2 SET eventtime=$qeventtime, revttime=$LJ::EndOfTime-".
1983	"UNIX_TIMESTAMP($qeventtime), year=$qyear, month=$qmonth, day=$qday, ".
1984	"security=$qsecurity, allowmask=$qallowmask WHERE journalid=$ownerid ".
1985	"AND jitemid=$itemid");
1986	return fail($err,501,$dberr) if $dberr;
1987
1988	# update memcached
1989	my $sec = $qallowmask;
1990	$sec = 0 if $security eq 'private';
1991	$sec = 2**31 if $security eq 'public';
1992
1993	my $row = pack("NNNNN", $oldevent->{'posterid'},
1994	LJ::mysqldate_to_time($eventtime, 1),
1995	LJ::mysqldate_to_time($oldevent->{'logtime'}, 1),
1996	$sec,
1997	$itemid*256 + $oldevent->{'anum'});
1998
1999	LJ::MemCache::set([$ownerid, "log2:$ownerid:$itemid"], $row);
2000
2001	}
2002
2003	if ($security ne $oldevent->{'security'} \|\|
2004	$qallowmask != $oldevent->{'allowmask'})
2005	{
2006	if ($security eq "public" \|\| $security eq "private") {
2007	$uowner->do("DELETE FROM logsec2 WHERE journalid=$ownerid AND jitemid=$itemid");
2008	} else {
2009	$uowner->do("REPLACE INTO logsec2 (journalid, jitemid, allowmask) ".
2010	"VALUES ($ownerid, $itemid, $qallowmask)");
2011	}
2012	return fail($err,501,$dbcm->errstr) if $uowner->err;
2013	}
2014
2015	LJ::MemCache::set([$ownerid,"logtext:$clusterid:$ownerid:$itemid"],
2016	[ $req->{'subject'}, $event ]);
2017
2018	if (!$flags->{'use_old_content'} && (
2019	$event ne $oldevent->{'event'} \|\|
2020	$req->{'subject'} ne $oldevent->{'subject'}))
2021	{
2022	$uowner->do("UPDATE logtext2 SET subject=?, event=? ".
2023	"WHERE journalid=$ownerid AND jitemid=$itemid", undef,
2024	$req->{'subject'}, LJ::text_compress($event));
2025	return fail($err,501,$uowner->errstr) if $uowner->err;
2026
2027	# update disk usage
2028	$uowner->dudata_set('L', $itemid, $bytes);
2029	}
2030
2031	# up the revision number
2032	$req->{'props'}->{'revnum'} = ($curprops{$itemid}->{'revnum'} \|\| 0) + 1;
2033	$req->{'props'}->{'revtime'} = time();
2034
2035	my $res = { 'itemid' => $itemid };
2036
2037	# handle tags if they're defined
2038	if ($do_tags) {
2039	my $tagerr = "";
2040	my $skipped_tags = [];
2041	my $rv = LJ::Tags::update_logtags($uowner, $itemid, {
2042	set_string => $req->{props}->{taglist},
2043	remote => $u,
2044	err_ref => \$tagerr,
2045	skipped_tags => $skipped_tags, # do all possible and report impossible
2046	});
2047	push @{$res->{warnings} \|\|= []}, LJ::Lang::ml('/update.bml.tags.skipped', { 'tags' => join(', ', @$skipped_tags),
2048	'limit' => $uowner->get_cap('tags_max') } )
2049	if @$skipped_tags;
2050	}
2051
2052	if (LJ::is_enabled('default_copyright', $u)) {
2053	unless (defined $req->{'props'}->{'copyright'}) { # try 1: previous value
2054	$req->{'props'}->{'copyright'} = $curprops{$itemid}->{'copyright'};
2055	}
2056	unless (defined $req->{'props'}->{'copyright'}) { # try 2: global setting
2057	$req->{'props'}->{'copyright'} = $uowner->prop('default_copyright');
2058	}
2059	unless (defined $req->{'props'}->{'copyright'}) { # try 3: allow
2060	$req->{'props'}->{'copyright'} = 'P';
2061	}
2062	} else { # disabled feature
2063	delete $req->{'props'}->{'copyright'};
2064	}
2065
2066	# handle the props
2067	{
2068	my $propset = {};
2069	foreach my $pname (keys %{$req->{'props'}}) {
2070	my $p = LJ::get_prop("log", $pname);
2071	next unless $p;
2072	$propset->{$pname} = $req->{'props'}->{$pname};
2073	}
2074	LJ::set_logprop($uowner, $itemid, $propset);
2075
2076	if ($req->{'props'}->{'copyright'} ne $curprops{$itemid}->{'copyright'}) {
2077	LJ::Entry->new($ownerid, jitemid => $itemid)->put_logprop_in_history('copyright', $curprops{$itemid}->{'copyright'},
2078	$req->{'props'}->{'copyright'});
2079	}
2080	}
2081
2082	# deal with backdated changes. if the entry's rlogtime is
2083	# $EndOfTime, then it's backdated. if they want that off, need to
2084	# reset rlogtime to real reverse log time. also need to set
2085	# rlogtime to $EndOfTime if they're turning backdate on.
2086	if ($req->{'props'}->{'opt_backdated'} eq "1" &&
2087	$oldevent->{'rlogtime'} != $LJ::EndOfTime) {
2088	my $dberr;
2089	$uowner->log2_do(undef, "UPDATE log2 SET rlogtime=$LJ::EndOfTime WHERE ".
2090	"journalid=$ownerid AND jitemid=$itemid");
2091	return fail($err,501,$dberr) if $dberr;
2092	}
2093	if ($req->{'props'}->{'opt_backdated'} eq "0" &&
2094	$oldevent->{'rlogtime'} == $LJ::EndOfTime) {
2095	my $dberr;
2096	$uowner->log2_do(\$dberr, "UPDATE log2 SET rlogtime=$LJ::EndOfTime-UNIX_TIMESTAMP(logtime) ".
2097	"WHERE journalid=$ownerid AND jitemid=$itemid");
2098	return fail($err,501,$dberr) if $dberr;
2099	}
2100	return fail($err,501,$dbcm->errstr) if $dbcm->err;
2101
2102	LJ::memcache_kill($ownerid, "dayct2");
2103
2104	if (defined $oldevent->{'anum'}) {
2105	$res->{'anum'} = $oldevent->{'anum'};
2106	$res->{'url'} = LJ::item_link($uowner, $itemid, $oldevent->{'anum'});
2107	}
2108
2109	my $entry = LJ::Entry->new($ownerid, jitemid => $itemid);
2110	LJ::EventLogRecord::EditEntry->new($entry)->fire;
2111	my @jobs; # jobs to insert into TheSchwartz
2112	LJ::run_hooks("editpost", $entry, \@jobs);
2113
2114	# PubSubHubbub Support
2115	LJ::Feed::generate_hubbub_jobs($uowner, \@jobs) unless $uowner->is_syndicated;
2116
2117	my $sclient = LJ::theschwartz();
2118	if ($sclient && @jobs) {
2119	my @handles = $sclient->insert_jobs(@jobs);
2120	# TODO: error on failure? depends on the job I suppose? property of the job?
2121	}
2122
2123	return $res;
2124	}
2125
2126	sub getevents
2127	{
2128	my ($req, $err, $flags) = @_;
2129	return undef unless authenticate($req, $err, $flags);
2130
2131	$flags->{'ignorecanuse'} = 1; # later we will check security levels, so allow some access to communities
2132	return undef unless check_altusage($req, $err, $flags);
2133
2134	my $u = $flags->{'u'};
2135	my $uowner = $flags->{'u_owner'} \|\| $u;
2136
2137	### shared-journal support
2138	my $posterid = $u->{'userid'};
2139	my $ownerid = $flags->{'ownerid'};
2140
2141	my $dbr = LJ::get_db_reader();
2142	my $sth;
2143
2144	my $dbcr = LJ::get_cluster_reader($uowner);
2145	return fail($err,502) unless $dbcr && $dbr;
2146
2147	# can't pull events from deleted/suspended journal
2148	return fail($err,307) unless $uowner->{'statusvis'} eq "V" \|\| $uowner->is_readonly;
2149
2150	my $reject_code = $LJ::DISABLE_PROTOCOL{getevents};
2151	if (ref $reject_code eq "CODE") {
2152	my $errmsg = $reject_code->($req, $flags, eval { LJ::request->request });
2153	if ($errmsg) { return fail($err, "311", $errmsg); }
2154	}
2155
2156	# if this is on, we sort things different (logtime vs. posttime)
2157	# to avoid timezone issues
2158	my $is_community = ($uowner->{'journaltype'} eq "C" \|\|
2159	$uowner->{'journaltype'} eq "S");
2160
2161	# in some cases we'll use the master, to ensure there's no
2162	# replication delay. useful cases: getting one item, use master
2163	# since user might have just made a typo and realizes it as they
2164	# post, or wants to append something they forgot, etc, etc. in
2165	# other cases, slave is pretty sure to have it.
2166	my $use_master = 0;
2167
2168	# the benefit of this mode over actually doing 'lastn/1' is
2169	# the $use_master usage.
2170	if ($req->{'selecttype'} eq "one" && $req->{'itemid'} eq "-1") {
2171	$req->{'selecttype'} = "lastn";
2172	$req->{'howmany'} = 1;
2173	undef $req->{'itemid'};
2174	$use_master = 1; # see note above.
2175	}
2176
2177	# just synonym
2178	if ($req->{'itemshow'}){
2179	$req->{'selecttype'} = 'lastn' unless $req->{'selecttype'};
2180	$req->{'howmany'} = $req->{'itemshow'};
2181	}
2182	my $skip = $req->{'skip'} + 0;
2183	if ($skip > 500) { $skip = 500; }
2184
2185	# build the query to get log rows. each selecttype branch is
2186	# responsible for either populating the following 3 variables
2187	# OR just populating $sql
2188	my ($orderby, $where, $limit, $offset);
2189	my $sql;
2190	if ($req->{'selecttype'} eq "day")
2191	{
2192	return fail($err,203)
2193	unless ($req->{'year'} =~ /^\d\d\d\d$/ &&
2194	$req->{'month'} =~ /^\d\d?$/ &&
2195	$req->{'day'} =~ /^\d\d?$/ &&
2196	$req->{'month'} >= 1 && $req->{'month'} <= 12 &&
2197	$req->{'day'} >= 1 && $req->{'day'} <= 31);
2198
2199	my $qyear = $dbr->quote($req->{'year'});
2200	my $qmonth = $dbr->quote($req->{'month'});
2201	my $qday = $dbr->quote($req->{'day'});
2202	$where = "AND year=$qyear AND month=$qmonth AND day=$qday";
2203	$limit = "LIMIT 200"; # FIXME: unhardcode this constant (also in ljviews.pl)
2204
2205	# see note above about why the sort order is different
2206	$orderby = $is_community ? "ORDER BY logtime" : "ORDER BY eventtime";
2207	}
2208	elsif ($req->{'selecttype'} eq "lastn")
2209	{
2210	my $howmany = $req->{'howmany'} \|\| 20;
2211	if ($howmany > 50) { $howmany = 50; }
2212	$howmany = $howmany + 0;
2213	$limit = "LIMIT $howmany";
2214
2215	$offset = "OFFSET $skip";
2216
2217	# okay, follow me here... see how we add the revttime predicate
2218	# even if no beforedate key is present? you're probably saying,
2219	# that's retarded -- you're saying: "revttime > 0", that's like
2220	# saying, "if entry occurred at all." yes yes, but that hints
2221	# mysql's braindead optimizer to use the right index.
2222	my $rtime_after = 0;
2223	my $rtime_what = $is_community ? "rlogtime" : "revttime";
2224	if ($req->{'beforedate'}) {
2225	return fail($err,203,"Invalid beforedate format.")
2226	unless ($req->{'beforedate'} =~
2227	/^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d$/);
2228	my $qd = $dbr->quote($req->{'beforedate'});
2229	$rtime_after = "$LJ::EndOfTime-UNIX_TIMESTAMP($qd)";
2230	}
2231	$where .= "AND $rtime_what > $rtime_after ";
2232	$orderby = "ORDER BY $rtime_what";
2233	}
2234	elsif ($req->{'selecttype'} eq "one")
2235	{
2236	my $id = $req->{'itemid'} + 0;
2237	$where = "AND jitemid=$id";
2238	}
2239	elsif ($req->{'selecttype'} eq "syncitems")
2240	{
2241	return fail($err,506) if $LJ::DISABLED{'syncitems'};
2242	my $date = $req->{'lastsync'} \|\| "0000-00-00 00:00:00";
2243	return fail($err,203,"Invalid syncitems date format")
2244	unless ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
2245
2246	my $now = time();
2247	# broken client loop prevention
2248	if ($req->{'lastsync'}) {
2249	my $pname = "rl_syncitems_getevents_loop";
2250	LJ::load_user_props($u, $pname);
2251	# format is: time/date/time/date/time/date/... so split
2252	# it into a hash, then delete pairs that are older than an hour
2253	my %reqs = split(m!/!, $u->{$pname});
2254	foreach (grep { $_ < $now - 60*60 } keys %reqs) { delete $reqs{$_}; }
2255	my $count = grep { $_ eq $date } values %reqs;
2256	$reqs{$now} = $date;
2257	if ($count >= 2) {
2258	# 2 prior, plus this one = 3 repeated requests for same synctime.
2259	# their client is busted. (doesn't understand syncitems semantics)
2260	return fail($err,406);
2261	}
2262	LJ::set_userprop($u, $pname,
2263	join('/', map { $_, $reqs{$_} }
2264	sort { $b <=> $a } keys %reqs));
2265	}
2266
2267	my %item;
2268	$sth = $dbcr->prepare("SELECT jitemid, logtime FROM log2 WHERE ".
2269	"journalid=? and logtime > ?");
2270	$sth->execute($ownerid, $date);
2271	while (my ($id, $dt) = $sth->fetchrow_array) {
2272	$item{$id} = $dt;
2273	}
2274
2275	my $p_revtime = LJ::get_prop("log", "revtime");
2276	$sth = $dbcr->prepare("SELECT jitemid, FROM_UNIXTIME(value) ".
2277	"FROM logprop2 WHERE journalid=? ".
2278	"AND propid=$p_revtime->{'id'} ".
2279	"AND value+0 > UNIX_TIMESTAMP(?)");
2280	$sth->execute($ownerid, $date);
2281	while (my ($id, $dt) = $sth->fetchrow_array) {
2282	$item{$id} = $dt;
2283	}
2284
2285	my $limit = 100;
2286	my @ids = sort { $item{$a} cmp $item{$b} } keys %item;
2287	if (@ids > $limit) { @ids = @ids[0..$limit-1]; }
2288
2289	my $in = join(',', @ids) \|\| "0";
2290	$where = "AND jitemid IN ($in)";
2291	}
2292	elsif ($req->{'selecttype'} eq "multiple")
2293	{
2294	my @ids;
2295	foreach my $num (split(/\s,\s/, $req->{'itemids'})) {
2296	return fail($err,203,"Non-numeric itemid") unless $num =~ /^\d+$/;
2297	push @ids, $num;
2298	}
2299	my $limit = 100;
2300	return fail($err,209,"Can't retrieve more than $limit entries at once") if @ids > $limit;
2301	my $in = join(',', @ids);
2302	$where = "AND jitemid IN ($in)";
2303	}
2304	elsif ($req->{'selecttype'} eq 'before')
2305	{
2306	my $before = $req->{'before'};
2307	my $itemshow = $req->{'howmany'};
2308	my $itemselect = $itemshow + $skip;
2309
2310	my %item;
2311	$sth = $dbcr->prepare("SELECT jitemid, logtime FROM log2 WHERE ".
2312	"journalid=? and logtime < ? LIMIT $itemselect");
2313	$sth->execute($ownerid, $before);
2314	while (my ($id, $dt) = $sth->fetchrow_array) {
2315	$item{$id} = $dt;
2316
2317	}
2318
2319	my $p_revtime = LJ::get_prop("log", "revtime");
2320
2321	$sth = $dbcr->prepare("SELECT jitemid, FROM_UNIXTIME(value) ".
2322	"FROM logprop2 WHERE journalid=? ".
2323	"AND propid=$p_revtime->{'id'} ".
2324	"AND value+0 < ? LIMIT $itemselect");
2325	$sth->execute($ownerid, $before);
2326	while (my ($id, $dt) = $sth->fetchrow_array) {
2327	$item{$id} = $dt;
2328	}
2329
2330	my @ids = sort { $item{$a} cmp $item{$b} } keys %item;
2331	if (@ids > $skip){
2332	@ids = @ids[$skip..(@ids-1)];
2333	@ids = @ids[0..$itemshow-1] if @ids > $itemshow;
2334	}else{
2335	@ids = ();
2336	}
2337
2338	my $in = join(',', @ids) \|\| "0";
2339	$where = "AND jitemid IN ($in)";
2340	}
2341	else
2342	{
2343	return fail($err,200,"Invalid selecttype.");
2344	}
2345
2346	my $secmask = 0;
2347	if ($u && ($u->{'journaltype'} eq "P" \|\| $u->{'journaltype'} eq "I") && $posterid != $ownerid) {
2348	$secmask = LJ::get_groupmask($ownerid, $posterid);
2349	}
2350
2351	# decide what level of security the remote user can see
2352	# 'getevents' used in small count of places and we will not pass 'viewall' through their call chain
2353	my $secwhere = "";
2354	if ($posterid == $ownerid) {
2355	# no extra where restrictions... user can see all their own stuff
2356	} elsif ($secmask) {
2357	# can see public or things with them in the mask
2358	$secwhere = "AND (security='public' OR (security='usemask' AND allowmask & $secmask != 0) OR posterid=$posterid)";
2359	} else {
2360	# not a friend? only see public.
2361	$secwhere = "AND (security='public' OR posterid=$posterid)";
2362	}
2363
2364	# common SQL template:
2365	unless ($sql) {
2366	$sql = "SELECT jitemid, eventtime, security, allowmask, anum, posterid, replycount, UNIX_TIMESTAMP(eventtime) ".
2367	"FROM log2 WHERE journalid=$ownerid $secwhere $where $orderby $limit $offset";
2368	}
2369
2370	# whatever selecttype might have wanted us to use the master db.
2371	$dbcr = LJ::get_cluster_def_reader($uowner) if $use_master;
2372
2373	return fail($err,502) unless $dbcr;
2374
2375	## load the log rows
2376	($sth = $dbcr->prepare($sql))->execute;
2377	return fail($err,501,$dbcr->errstr) if $dbcr->err;
2378
2379	my $count = 0;
2380	my @itemids = ();
2381	my $res = { skip => $skip };
2382	my $events = $res->{'events'} = [];
2383	my %evt_from_itemid;
2384
2385	while (my ($itemid, $eventtime, $sec, $mask, $anum, $jposterid, $replycount, $event_timestamp) = $sth->fetchrow_array)
2386	{
2387	$count++;
2388	my $evt = {};
2389	$evt->{'itemid'} = $itemid;
2390	push @itemids, $itemid;
2391
2392	$evt_from_itemid{$itemid} = $evt;
2393
2394	$evt->{"eventtime"} = $eventtime;
2395	$evt->{event_timestamp} = $event_timestamp;
2396	if ($sec ne "public") {
2397	$evt->{'security'} = $sec;
2398	$evt->{'allowmask'} = $mask if $sec eq "usemask";
2399	}
2400	$evt->{'anum'} = $anum;
2401	$evt->{'poster'} = LJ::get_username($dbr, $jposterid) if $jposterid != $ownerid;
2402	$evt->{'url'} = LJ::item_link($uowner, $itemid, $anum);
2403	$evt->{'reply_count'} = $replycount;
2404	push @$events, $evt;
2405	}
2406
2407	# load properties. Even if the caller doesn't want them, we need
2408	# them in Unicode installations to recognize older 8bit non-UF-8
2409	# entries.
2410	unless ($req->{'noprops'} && !$LJ::UNICODE)
2411	{
2412	### do the properties now
2413	$count = 0;
2414	my %props = ();
2415	LJ::load_log_props2($dbcr, $ownerid, \@itemids, \%props);
2416
2417	# load the tags for these entries, unless told not to
2418	unless ($req->{notags}) {
2419	# construct %idsbycluster for the multi call to get these tags
2420	my $tags = LJ::Tags::get_logtags($uowner, \@itemids);
2421
2422	# add to props
2423	foreach my $itemid (@itemids) {
2424	next unless $tags->{$itemid};
2425	$props{$itemid}->{taglist} = join(', ', values %{$tags->{$itemid}});
2426	}
2427	}
2428
2429	foreach my $itemid (keys %props) {
2430	# 'replycount' is a pseudo-prop, don't send it.
2431	# FIXME: this goes away after we restructure APIs and
2432	# replycounts cease being transferred in props
2433	delete $props{$itemid}->{'replycount'};
2434
2435	my $evt = $evt_from_itemid{$itemid};
2436	$evt->{'props'} = {};
2437	foreach my $name (keys %{$props{$itemid}}) {
2438	my $value = $props{$itemid}->{$name};
2439	$value =~ s/\n/ /g;
2440	$evt->{'props'}->{$name} = $value;
2441	}
2442	}
2443	}
2444
2445	## load the text
2446	my $text = LJ::cond_no_cache($use_master, sub {
2447	return LJ::get_logtext2($uowner, @itemids);
2448	});
2449
2450	foreach my $i (@itemids)
2451	{
2452	my $t = $text->{$i};
2453	my $evt = $evt_from_itemid{$i};
2454
2455	# if they want subjects to be events, replace event
2456	# with subject when requested.
2457	if ($req->{'prefersubject'} && length($t->[0])) {
2458	$t->[1] = $t->[0]; # event = subject
2459	$t->[0] = undef; # subject = undef
2460	}
2461
2462	# now that we have the subject, the event and the props,
2463	# auto-translate them to UTF-8 if they're not in UTF-8.
2464	if ($LJ::UNICODE && $req->{'ver'} >= 1 &&
2465	$evt->{'props'}->{'unknown8bit'}) {
2466	my $error = 0;
2467	$t->[0] = LJ::text_convert($t->[0], $uowner, \$error);
2468	$t->[1] = LJ::text_convert($t->[1], $uowner, \$error);
2469	foreach (keys %{$evt->{'props'}}) {
2470	$evt->{'props'}->{$_} = LJ::text_convert($evt->{'props'}->{$_}, $uowner, \$error);
2471	}
2472	return fail($err,208,"Cannot display this post. Please see $LJ::SITEROOT/support/encodings.bml for more information.")
2473	if $error;
2474	}
2475
2476	if ($LJ::UNICODE && $req->{'ver'} < 1 && !$evt->{'props'}->{'unknown8bit'}) {
2477	unless ( LJ::is_ascii($t->[0]) &&
2478	LJ::is_ascii($t->[1]) &&
2479	LJ::is_ascii(join(' ', values %{$evt->{'props'}}) )) {
2480	# we want to fail the client that wants to get this entry
2481	# but we make an exception for selecttype=day, in order to allow at least
2482	# viewing the daily summary
2483
2484	if ($req->{'selecttype'} eq 'day') {
2485	$t->[0] = $t->[1] = $CannotBeShown;
2486	} else {
2487	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.");
2488	}
2489	}
2490	}
2491
2492	if ($t->[0]) {
2493	$t->[0] =~ s/[\r\n]/ /g;
2494	$evt->{'subject'} = $t->[0];
2495	}
2496
2497	$t->[1] = LJ::trim_widgets(
2498	length => $req->{trim_widgets},
2499	img_length => $req->{widgets_img_length},
2500	text => $t->[1],
2501	read_more => '<a href="' . $evt->{url} . '"> ...</a>',
2502	) if $req->{trim_widgets};
2503
2504	$t->[1] = LJ::convert_lj_tags_to_links(
2505	event => $t->[1],
2506	embed_url => $evt->{url},
2507	) if $req->{parseljtags};
2508
2509
2510	# truncate
2511	if ($req->{'truncate'} >= 4) {
2512	my $original = $t->[1];
2513	if ($req->{'ver'} > 1) {
2514	$t->[1] = LJ::text_trim($t->[1], $req->{'truncate'} - 3, 0);
2515	} else {
2516	$t->[1] = LJ::text_trim($t->[1], 0, $req->{'truncate'} - 3);
2517	}
2518	# only append the elipsis if the text was actually truncated
2519	$t->[1] .= "..." if $t->[1] ne $original;
2520	}
2521
2522	# line endings
2523	$t->[1] =~ s/\r//g;
2524	if ($req->{'lineendings'} eq "unix") {
2525	# do nothing. native format.
2526	} elsif ($req->{'lineendings'} eq "mac") {
2527	$t->[1] =~ s/\n/\r/g;
2528	} elsif ($req->{'lineendings'} eq "space") {
2529	$t->[1] =~ s/\n/ /g;
2530	} elsif ($req->{'lineendings'} eq "dots") {
2531	$t->[1] =~ s/\n/ ... /g;
2532	} else { # "pc" -- default
2533	$t->[1] =~ s/\n/\r\n/g;
2534	}
2535	$evt->{'event'} = $t->[1];
2536	}
2537
2538	# maybe we don't need the props after all
2539	if ($req->{'noprops'}) {
2540	foreach(@$events) { delete $_->{'props'}; }
2541	}
2542
2543	return $res;
2544	}
2545
2546	sub editfriends
2547	{
2548	my ($req, $err, $flags) = @_;
2549	return undef unless authenticate($req, $err, $flags);
2550
2551	my $u = $flags->{'u'};
2552	my $userid = $u->{'userid'};
2553	my $dbh = LJ::get_db_writer();
2554	my $sth;
2555
2556	return fail($err,306) unless $dbh;
2557
2558	# do not let locked people do this
2559	return fail($err, 308) if $u->{statusvis} eq 'L';
2560
2561	#
2562	# Do not have values for $LJ::ADD_FRIEND_RATE_LIMIT
2563	#
2564	# # check action frequency
2565	# unless ($flags->{no_rate_check}){
2566	# my $cond = ["ratecheck:add_friend:$userid",
2567	# [ $LJ::ADD_FRIEND_RATE_LIMIT \|\| [ 10, 600 ] ]
2568	# ];
2569	# return fail($err, 411)
2570	# unless LJ::RateLimit->check($u, [ $cond ]);
2571	# }
2572
2573	my $res = {};
2574
2575	## first, figure out who the current friends are to save us work later
2576	my %curfriend;
2577	my $friend_count = 0;
2578	my $friends_changed = 0;
2579
2580	# TAG:FR:protocol:editfriends1
2581	$sth = $dbh->prepare("SELECT u.user FROM useridmap u, friends f ".
2582	"WHERE u.userid=f.friendid AND f.userid=$userid");
2583	$sth->execute;
2584	while (my ($friend) = $sth->fetchrow_array) {
2585	$curfriend{$friend} = 1;
2586	$friend_count++;
2587	}
2588	$sth->finish;
2589
2590	# perform the deletions
2591	DELETEFRIEND:
2592	foreach (@{$req->{'delete'}})
2593	{
2594	my $deluser = LJ::canonical_username($_);
2595	next DELETEFRIEND unless ($curfriend{$deluser});
2596
2597	my $friendid = LJ::get_userid($deluser);
2598	# TAG:FR:protocol:editfriends2_del
2599	LJ::remove_friend($userid, $friendid);
2600	$friend_count--;
2601	$friends_changed = 1;
2602	}
2603
2604	my $error_flag = 0;
2605	my $friends_added = 0;
2606	my $fail = sub {
2607	LJ::memcache_kill($userid, "friends");
2608	LJ::mark_dirty($userid, "friends");
2609	return fail($err, $_[0], $_[1]);
2610	};
2611
2612	# only people, shared journals, and owned syn feeds can add friends
2613	return $fail->(104, "Journal type cannot add friends")
2614	unless ($u->{'journaltype'} eq 'P' \|\|
2615	$u->{'journaltype'} eq 'S' \|\|
2616	$u->{'journaltype'} eq 'I' \|\|
2617	($u->{'journaltype'} eq "Y" && $u->password));
2618
2619	# Don't let suspended users add friend
2620	return $fail->(305, "Suspended journals cannot add friends.")
2621	if ($u->is_suspended);
2622
2623	my $sclient = LJ::theschwartz();
2624
2625	# perform the adds
2626	ADDFRIEND:
2627	foreach my $fa (@{$req->{'add'}})
2628	{
2629	unless (ref $fa eq "HASH") {
2630	$fa = { 'username' => $fa };
2631	}
2632
2633	my $aname = LJ::canonical_username($fa->{'username'});
2634	unless ($aname) {
2635	$error_flag = 1;
2636	next ADDFRIEND;
2637	}
2638
2639	$friend_count++ unless $curfriend{$aname};
2640
2641	my $err;
2642	return $fail->(104, "$err")
2643	unless $u->can_add_friends(\$err, { 'numfriends' => $friend_count, friend => $fa });
2644
2645	my $fg = $fa->{'fgcolor'} \|\| "#000000";
2646	my $bg = $fa->{'bgcolor'} \|\| "#FFFFFF";
2647	if ($fg !~ /^\#[0-9A-F]{6,6}$/i \|\| $bg !~ /^\#[0-9A-F]{6,6}$/i) {
2648	return $fail->(203, "Invalid color values");
2649	}
2650
2651	my $row = LJ::load_user($aname);
2652	my $currently_is_friend = LJ::is_friend($u, $row);
2653	my $currently_is_banned = LJ::is_banned($u, $row);
2654
2655	# XXX - on some errors we fail out, on others we continue and try adding
2656	# any other users in the request. also, error message for redirect should
2657	# point the user to the redirected username.
2658	if (! $row) {
2659	$error_flag = 1;
2660	} elsif ($row->{'journaltype'} eq "R") {
2661	return $fail->(154);
2662	} elsif ($row->{'statusvis'} ne "V") {
2663	$error_flag = 1;
2664	} else {
2665	$friends_added++;
2666	my $added = { 'username' => $aname,
2667	'fullname' => $row->{'name'},
2668	'journaltype' => $row->{journaltype},
2669	'defaultpicurl' => ($row->{'defaultpicid'} && "$LJ::USERPIC_ROOT/$row->{'defaultpicid'}/$row->{'userid'}"),
2670	};
2671	if ($req->{'ver'} >= 1) {
2672	LJ::text_out(\$added->{'fullname'});
2673	}
2674	push @{$res->{'added'}}, $added;
2675
2676	my $qfg = LJ::color_todb($fg);
2677	my $qbg = LJ::color_todb($bg);
2678
2679	my $friendid = $row->{'userid'};
2680
2681	my $gmask = $fa->{'groupmask'};
2682	if (! $gmask && $curfriend{$aname}) {
2683	# if no group mask sent, use the existing one if this is an existing friend
2684	# TAG:FR:protocol:editfriends3_getmask
2685	my $sth = $dbh->prepare("SELECT groupmask FROM friends ".
2686	"WHERE userid=$userid AND friendid=$friendid");
2687	$sth->execute;
2688	$gmask = $sth->fetchrow_array;
2689	}
2690	# force bit 0 on.
2691	$gmask \|= 1;
2692
2693	# TAG:FR:protocol:editfriends4_addeditfriend
2694	my $cnt = $dbh->do("REPLACE INTO friends (userid, friendid, fgcolor, bgcolor, groupmask) ".
2695	"VALUES ($userid, $friendid, $qfg, $qbg, $gmask)");
2696	return $fail->(501,$dbh->errstr) if $dbh->err;
2697
2698	if ($cnt == 1) {
2699	LJ::run_hooks('befriended', LJ::load_userid($userid), LJ::load_userid($friendid));
2700	}
2701
2702	my $memkey = [$userid,"frgmask:$userid:$friendid"];
2703	LJ::MemCache::set($memkey, $gmask+0, time()+60*15);
2704	LJ::memcache_kill($friendid, 'friendofs');
2705	LJ::memcache_kill($friendid, 'friendofs2');
2706
2707	if ($sclient && !$currently_is_friend && !$currently_is_banned) {
2708	my @jobs;
2709	push @jobs, LJ::Event::Befriended->new(LJ::load_userid($friendid), LJ::load_userid($userid))->fire_job
2710	if !$LJ::DISABLED{esn};
2711
2712	push @jobs, TheSchwartz::Job->new(
2713	funcname => "LJ::Worker::FriendChange",
2714	arg => [$userid, 'add', $friendid],
2715	) unless $LJ::DISABLED{'friendchange-schwartz'};
2716
2717	$sclient->insert_jobs(@jobs) if @jobs;
2718	}
2719	$friends_changed = 1;
2720	}
2721	}
2722
2723	return $fail->(104) if $error_flag;
2724
2725	# invalidate memcache of friends
2726	LJ::memcache_kill($userid, "friends");
2727	LJ::memcache_kill($userid, "friends2");
2728	LJ::mark_dirty($userid, "friends");
2729
2730	LJ::run_hooks('friends_changed', LJ::load_userid($userid)) if $friends_changed;
2731
2732	return $res;
2733	}
2734
2735	sub editfriendgroups
2736	{
2737	my ($req, $err, $flags) = @_;
2738	return undef unless authenticate($req, $err, $flags);
2739
2740	my $u = $flags->{'u'};
2741	my $userid = $u->{'userid'};
2742	my ($db, $fgtable, $bmax, $cmax) = $u->{dversion} > 5 ?
2743	($u->writer, 'friendgroup2', LJ::BMAX_GRPNAME2, LJ::CMAX_GRPNAME2) :
2744	(LJ::get_db_writer(), 'friendgroup', LJ::BMAX_GRPNAME, LJ::CMAX_GRPNAME);
2745	my $sth;
2746
2747	return fail($err,306) unless $db;
2748
2749	# do not let locked people do this
2750	return fail($err, 308) if $u->{statusvis} eq 'L';
2751
2752	my $res = {};
2753
2754	## make sure tree is how we want it
2755	$req->{'groupmasks'} = {} unless
2756	(ref $req->{'groupmasks'} eq "HASH");
2757	$req->{'set'} = {} unless
2758	(ref $req->{'set'} eq "HASH");
2759	$req->{'delete'} = [] unless
2760	(ref $req->{'delete'} eq "ARRAY");
2761
2762	# Keep track of what bits are already set, so we can know later
2763	# whether to INSERT or UPDATE.
2764	my %bitset;
2765	my $groups = LJ::get_friend_group($userid);
2766	foreach my $bit (keys %{$groups \|\| {}}) {
2767	$bitset{$bit} = 1;
2768	}
2769
2770	## before we perform any DB operations, validate input text
2771	# (groups' names) for correctness so we can fail gracefully
2772	if ($LJ::UNICODE) {
2773	foreach my $bit (keys %{$req->{'set'}})
2774	{
2775	my $name = $req->{'set'}->{$bit}->{'name'};
2776	return fail($err,207,"non-ASCII names require a Unicode-capable client")
2777	if $req->{'ver'} < 1 and not LJ::is_ascii($name);
2778	return fail($err,208,"Invalid group names. Please see $LJ::SITEROOT/support/encodings.bml for more information.")
2779	unless LJ::text_in($name);
2780	}
2781	}
2782
2783	## figure out deletions we'll do later
2784	foreach my $bit (@{$req->{'delete'}})
2785	{
2786	$bit += 0;
2787	next unless ($bit >= 1 && $bit <= 30);
2788	$bitset{$bit} = 0; # so later we replace into, not update.
2789	}
2790
2791	## do additions/modifications ('set' hash)
2792	my %added;
2793	foreach my $bit (keys %{$req->{'set'}})
2794	{
2795	$bit += 0;
2796	next unless ($bit >= 1 && $bit <= 30);
2797	my $sa = $req->{'set'}->{$bit};
2798	my $name = LJ::text_trim($sa->{'name'}, $bmax, $cmax);
2799
2800	# can't end with a slash
2801	$name =~ s!/$!!;
2802
2803	# setting it to name is like deleting it.
2804	unless ($name =~ /\S/) {
2805	push @{$req->{'delete'}}, $bit;
2806	next;
2807	}
2808
2809	my $qname = $db->quote($name);
2810	my $qsort = defined $sa->{'sort'} ? ($sa->{'sort'}+0) : 50;
2811	my $qpublic = $db->quote(defined $sa->{'public'} ? ($sa->{'public'}+0) : 0);
2812
2813	if ($bitset{$bit}) {
2814	# so update it
2815	my $sets;
2816	if (defined $sa->{'public'}) {
2817	$sets .= ", is_public=$qpublic";
2818	}
2819	$db->do("UPDATE $fgtable SET groupname=$qname, sortorder=$qsort ".
2820	"$sets WHERE userid=$userid AND groupnum=$bit");
2821	} else {
2822	$db->do("REPLACE INTO $fgtable (userid, groupnum, ".
2823	"groupname, sortorder, is_public) VALUES ".
2824	"($userid, $bit, $qname, $qsort, $qpublic)");
2825	}
2826	$added{$bit} = 1;
2827	}
2828
2829
2830	## do deletions ('delete' array)
2831	my $dbcm = LJ::get_cluster_master($u);
2832
2833	# ignore bits that aren't integers or that are outside 1-30 range
2834	my @delete_bits = grep {$_ >= 1 and $_ <= 30} map {$_+0} @{$req->{'delete'}};
2835	my $delete_mask = 0;
2836	foreach my $bit (@delete_bits) {
2837	$delete_mask \|= (1 << $bit)
2838	}
2839
2840	# remove the bits for deleted groups from all friends groupmasks
2841	my $dbh = LJ::get_db_writer();
2842	if ($delete_mask) {
2843	# TAG:FR:protocol:editfriendgroups_removemasks
2844	$dbh->do("UPDATE friends".
2845	" SET groupmask = groupmask & ~$delete_mask".
2846	" WHERE userid = $userid");
2847	}
2848
2849	foreach my $bit (@delete_bits)
2850	{
2851	# remove all posts from allowing that group:
2852	my @posts_to_clean = ();
2853	$sth = $dbcm->prepare("SELECT jitemid FROM logsec2 WHERE journalid=$userid AND allowmask & (1 << $bit)");
2854	$sth->execute;
2855	while (my ($id) = $sth->fetchrow_array) { push @posts_to_clean, $id; }
2856	while (@posts_to_clean) {
2857	my @batch;
2858	if (scalar(@posts_to_clean) < 20) {
2859	@batch = @posts_to_clean;
2860	@posts_to_clean = ();
2861	} else {
2862	@batch = splice(@posts_to_clean, 0, 20);
2863	}
2864
2865	my $in = join(",", @batch);
2866	$u->do("UPDATE log2 SET allowmask=allowmask & ~(1 << $bit) ".
2867	"WHERE journalid=$userid AND jitemid IN ($in) AND security='usemask'");
2868	$u->do("UPDATE logsec2 SET allowmask=allowmask & ~(1 << $bit) ".
2869	"WHERE journalid=$userid AND jitemid IN ($in)");
2870
2871	foreach my $id (@batch) {
2872	LJ::MemCache::delete([$userid, "log2:$userid:$id"]);
2873	}
2874	LJ::MemCache::delete([$userid, "log2lt:$userid"]);
2875	}
2876	LJ::Tags::deleted_friend_group($u, $bit);
2877	LJ::run_hooks('delete_friend_group', $u, $bit);
2878
2879	# remove the friend group, unless we just added it this transaction
2880	unless ($added{$bit}) {
2881	$db->do("DELETE FROM $fgtable WHERE ".
2882	"userid=$userid AND groupnum=$bit");
2883	}
2884	}
2885
2886	## change friends' masks
2887	# TAG:FR:protocol:editfriendgroups_changemasks
2888	foreach my $friend (keys %{$req->{'groupmasks'}})
2889	{
2890	my $mask = int($req->{'groupmasks'}->{$friend}) \| 1;
2891	my $friendid = LJ::get_userid($dbh, $friend);
2892
2893	$dbh->do("UPDATE friends SET groupmask=$mask ".
2894	"WHERE userid=$userid AND friendid=?",
2895	undef, $friendid);
2896	LJ::MemCache::set([$userid, "frgmask:$userid:$friendid"], $mask);
2897	}
2898
2899	# invalidate memcache of friends/groups
2900	LJ::memcache_kill($userid, "friends");
2901	LJ::memcache_kill($userid, "fgrp");
2902	LJ::mark_dirty($u, "friends");
2903
2904	# return value for this is nothing.
2905	return {};
2906	}
2907
2908	sub sessionexpire {
2909	my ($req, $err, $flags) = @_;
2910	return undef unless authenticate($req, $err, $flags);
2911	my $u = $flags->{u};
2912
2913	# expunge one? or all?
2914	if ($req->{expireall}) {
2915	$u->kill_all_sessions;
2916	return {};
2917	}
2918
2919	# just expire a list
2920	my $list = $req->{expire} \|\| [];
2921	return {} unless @$list;
2922	return fail($err,502) unless $u->writer;
2923	$u->kill_sessions(@$list);
2924	return {};
2925	}
2926
2927	sub sessiongenerate {
2928	# generate a session
2929	my ($req, $err, $flags) = @_;
2930	return undef unless authenticate($req, $err, $flags);
2931
2932	# sanitize input
2933	$req->{expiration} = 'short' unless $req->{expiration} eq 'long';
2934	my $boundip;
2935	$boundip = LJ::get_remote_ip() if $req->{bindtoip};
2936
2937	my $u = $flags->{u};
2938	my $sess_opts = {
2939	exptype => $req->{expiration},
2940	ipfixed => $boundip,
2941	};
2942
2943	# do not let locked people do this
2944	return fail($err, 308) if $u->{statusvis} eq 'L';
2945
2946	my $sess = LJ::Session->create($u, %$sess_opts);
2947
2948	# return our hash
2949	return {
2950	ljsession => $sess->master_cookie_string,
2951	};
2952	}
2953
2954	sub list_friends
2955	{
2956	my ($u, $opts) = @_;
2957
2958	# do not show people in here
2959	my %hide; # userid -> 1
2960
2961	# TAG:FR:protocol:list_friends
2962	my $sql;
2963	unless ($opts->{'friendof'}) {
2964	$sql = "SELECT friendid, fgcolor, bgcolor, groupmask FROM friends WHERE userid=?";
2965	} else {
2966	$sql = "SELECT userid FROM friends WHERE friendid=?";
2967
2968	if (my $list = LJ::load_rel_user($u, 'B')) {
2969	$hide{$_} = 1 foreach @$list;
2970	}
2971	}
2972
2973	my $dbr = LJ::get_db_reader();
2974	my $sth = $dbr->prepare($sql);
2975	$sth->execute($u->{'userid'});
2976
2977	my @frow;
2978	while (my @row = $sth->fetchrow_array) {
2979	next if $hide{$row[0]};
2980	push @frow, [ @row ];
2981	}
2982
2983	my $us = LJ::load_userids(map { $_->[0] } @frow);
2984	my $limitnum = $opts->{'limit'}+0;
2985
2986	my $res = [];
2987	foreach my $f (sort { $us->{$a->[0]}{'user'} cmp $us->{$b->[0]}{'user'} }
2988	grep { $us->{$_->[0]} } @frow)
2989	{
2990	my $u = $us->{$f->[0]};
2991	next if $opts->{'friendof'} && $u->{'statusvis'} ne 'V';
2992
2993	my $r = {
2994	'username' => $u->{'user'},
2995	'fullname' => $u->{'name'},
2996	};
2997
2998
2999	if ($u->identity) {
3000	my $i = $u->identity;
3001	$r->{'identity_type'} = $i->pretty_type;
3002	$r->{'identity_value'} = $i->value;
3003	$r->{'identity_display'} = $u->display_name;
3004	}
3005
3006	if ($opts->{'includebdays'} &&
3007	$u->{'bdate'} &&
3008	$u->{'bdate'} ne "0000-00-00" &&
3009	$u->can_show_full_bday)
3010	{
3011	$r->{'birthday'} = $u->{'bdate'};
3012	}
3013
3014	unless ($opts->{'friendof'}) {
3015	$r->{'fgcolor'} = LJ::color_fromdb($f->[1]);
3016	$r->{'bgcolor'} = LJ::color_fromdb($f->[2]);
3017	$r->{"groupmask"} = $f->[3] if $f->[3] != 1;
3018	} else {
3019	$r->{'fgcolor'} = "#000000";
3020	$r->{'bgcolor'} = "#ffffff";
3021	}
3022
3023	$r->{"type"} = {
3024	'C' => 'community',
3025	'Y' => 'syndicated',
3026	'N' => 'news',
3027	'S' => 'shared',
3028	'I' => 'identity',
3029	}->{$u->{'journaltype'}} if $u->{'journaltype'} ne 'P';
3030
3031	$r->{"status"} = {
3032	'D' => "deleted",
3033	'S' => "suspended",
3034	'X' => "purged",
3035	}->{$u->{'statusvis'}} if $u->{'statusvis'} ne 'V';
3036
3037	$r->{defaultpicurl} = "$LJ::USERPIC_ROOT/$u->{'defaultpicid'}/$u->{'userid'}" if $u->{'defaultpicid'};
3038
3039	push @$res, $r;
3040	# won't happen for zero limit (which means no limit)
3041	last if @$res == $limitnum;
3042	}
3043	return $res;
3044	}
3045
3046	sub syncitems
3047	{
3048	my ($req, $err, $flags) = @_;
3049	return undef unless authenticate($req, $err, $flags);
3050	return undef unless check_altusage($req, $err, $flags);
3051	return fail($err,506) if $LJ::DISABLED{'syncitems'};
3052
3053	my $ownerid = $flags->{'ownerid'};
3054	my $uowner = $flags->{'u_owner'} \|\| $flags->{'u'};
3055	my $sth;
3056
3057	my $db = LJ::get_cluster_reader($uowner);
3058	return fail($err,502) unless $db;
3059
3060	## have a valid date?
3061	my $date = $req->{'lastsync'};
3062	if ($date) {
3063	return fail($err,203,"Invalid date format")
3064	unless ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
3065	} else {
3066	$date = "0000-00-00 00:00:00";
3067	}
3068
3069	my $LIMIT = 500;
3070
3071	my %item;
3072	$sth = $db->prepare("SELECT jitemid, logtime FROM log2 WHERE ".
3073	"journalid=? and logtime > ?");
3074	$sth->execute($ownerid, $date);
3075	while (my ($id, $dt) = $sth->fetchrow_array) {
3076	$item{$id} = [ 'L', $id, $dt, "create" ];
3077	}
3078
3079	my %cmt;
3080	my $p_calter = LJ::get_prop("log", "commentalter");
3081	my $p_revtime = LJ::get_prop("log", "revtime");
3082	$sth = $db->prepare("SELECT jitemid, propid, FROM_UNIXTIME(value) ".
3083	"FROM logprop2 WHERE journalid=? ".
3084	"AND propid IN ($p_calter->{'id'}, $p_revtime->{'id'}) ".
3085	"AND value+0 > UNIX_TIMESTAMP(?)");
3086	$sth->execute($ownerid, $date);
3087	while (my ($id, $prop, $dt) = $sth->fetchrow_array) {
3088	if ($prop == $p_calter->{'id'}) {
3089	$cmt{$id} = [ 'C', $id, $dt, "update" ];
3090	} elsif ($prop == $p_revtime->{'id'}) {
3091	$item{$id} = [ 'L', $id, $dt, "update" ];
3092	}
3093	}
3094
3095	my @ev = sort { $a->[2] cmp $b->[2] } (values %item, values %cmt);
3096
3097	my $res = {};
3098	my $list = $res->{'syncitems'} = [];
3099	$res->{'total'} = scalar @ev;
3100	my $ct = 0;
3101	while (my $ev = shift @ev) {
3102	$ct++;
3103	push @$list, { 'item' => "$ev->[0]-$ev->[1]",
3104	'time' => $ev->[2],
3105	'action' => $ev->[3], };
3106	last if $ct >= $LIMIT;
3107	}
3108	$res->{'count'} = $ct;
3109	return $res;
3110	}
3111
3112	sub consolecommand
3113	{
3114	my ($req, $err, $flags) = @_;
3115
3116	# logging in isn't necessary, but most console commands do require it
3117	LJ::set_remote($flags->{'u'}) if authenticate($req, $err, $flags);
3118
3119	my $res = {};
3120	my $cmdout = $res->{'results'} = [];
3121
3122	foreach my $cmd (@{$req->{'commands'}}) {
3123	# callee can pre-parse the args, or we can do it bash-style
3124	my @args = ref $cmd eq "ARRAY" ? @$cmd
3125	: LJ::Console->parse_line($cmd);
3126	my $c = LJ::Console->parse_array(@args);
3127	my $rv = $c->execute_safely;
3128
3129	my @output;
3130	push @output, [$_->status, $_->text] foreach $c->responses;
3131
3132	push @{$cmdout}, {
3133	'success' => $rv,
3134	'output' => \@output,
3135	};
3136	}
3137
3138	return $res;
3139	}
3140
3141	sub getchallenge
3142	{
3143	my ($req, $err, $flags) = @_;
3144	my $res = {};
3145	my $now = time();
3146	my $etime = 60;
3147	$res->{'challenge'} = LJ::challenge_generate($etime);
3148	$res->{'server_time'} = $now;
3149	$res->{'expire_time'} = $now + $etime;
3150	$res->{'auth_scheme'} = "c0"; # fixed for now, might support others later
3151	return $res;
3152	}
3153
3154	sub login_message
3155	{
3156	my ($req, $res, $flags) = @_;
3157	my $u = $flags->{'u'};
3158
3159	my $msg = sub {
3160	my $code = shift;
3161	my $args = shift \|\| {};
3162	$args->{'sitename'} = $LJ::SITENAME;
3163	$args->{'siteroot'} = $LJ::SITEROOT;
3164	my $pre = delete $args->{'pre'};
3165	$res->{'message'} = $pre . translate($u, $code, $args);
3166	};
3167
3168	return $msg->("readonly") if LJ::get_cap($u, "readonly");
3169	return $msg->("not_validated") if ($u->{'status'} eq "N" and not $LJ::EVERYONE_VALID);
3170	return $msg->("must_revalidate") if ($u->{'status'} eq "T" and not $LJ::EVERYONE_VALID);
3171
3172	my $checkpass = LJ::run_hook("bad_password", { 'u' => $u });
3173	return $msg->("bad_password", { 'pre' => "$checkpass " }) if $checkpass;
3174
3175	return $msg->("old_win32_client") if $req->{'clientversion'} =~ /^Win32-MFC\/(1.2.[0123456])$/;
3176	return $msg->("old_win32_client") if $req->{'clientversion'} =~ /^Win32-MFC\/(1.3.[01234])\b/;
3177	return $msg->("hello_test") if grep { $u->{user} eq $_ } @LJ::TESTACCTS;
3178	}
3179
3180	sub list_friendgroups
3181	{
3182	my $u = shift;
3183
3184	# get the groups for this user, return undef if error
3185	my $groups = LJ::get_friend_group($u);
3186	return undef unless $groups;
3187
3188	# we got all of the groups, so put them into an arrayref sorted by the
3189	# group sortorder; also note that the map is used to construct a new hashref
3190	# out of the old group hashref so that we have all of the field names converted
3191	# to a format our callers can recognize
3192	my @res = map { { id => $_->{groupnum}, name => $_->{groupname},
3193	public => $_->{is_public}, sortorder => $_->{sortorder}, } }
3194	sort { $a->{sortorder} <=> $b->{sortorder} }
3195	values %$groups;
3196
3197	return \@res;
3198	}
3199
3200	sub list_usejournals {
3201	my $u = shift;
3202
3203	my @us = $u->posting_access_list;
3204	my @unames = map { $_->{user} } @us;
3205
3206	return \@unames;
3207	}
3208
3209	sub hash_menus
3210	{
3211	my $u = shift;
3212	my $user = $u->{'user'};
3213
3214	my $menu = [
3215	{ 'text' => "Recent Entries",
3216	'url' => "$LJ::SITEROOT/users/$user/", },
3217	{ 'text' => "Calendar View",
3218	'url' => "$LJ::SITEROOT/users/$user/calendar", },
3219	{ 'text' => "Friends View",
3220	'url' => "$LJ::SITEROOT/users/$user/friends", },
3221	{ 'text' => "-", },
3222	{ 'text' => "Your Profile",
3223	'url' => "$LJ::SITEROOT/userinfo.bml?user=$user", },
3224	{ 'text' => "Your To-Do List",
3225	'url' => "$LJ::SITEROOT/todo/?user=$user", },
3226	{ 'text' => "-", },
3227	{ 'text' => "Change Settings",
3228	'sub' => [ { 'text' => "Personal Info",
3229	'url' => "$LJ::SITEROOT/manage/profile/", },
3230	{ 'text' => "Customize Journal",
3231	'url' =>"$LJ::SITEROOT/customize/", }, ] },
3232	{ 'text' => "-", },
3233	{ 'text' => "Support",
3234	'url' => "$LJ::SITEROOT/support/", }
3235	];
3236
3237	LJ::run_hooks("modify_login_menu", {
3238	'menu' => $menu,
3239	'u' => $u,
3240	'user' => $user,
3241	});
3242
3243	return $menu;
3244	}
3245
3246	sub list_pickws
3247	{
3248	my $u = shift;
3249
3250	my $pi = LJ::get_userpic_info($u);
3251	my @res;
3252
3253	my %seen; # mashifiedptr -> 1
3254
3255	# FIXME: should be a utf-8 sort
3256	foreach my $kw (sort keys %{$pi->{'kw'}}) {
3257	my $pic = $pi->{'kw'}{$kw};
3258	$seen{$pic} = 1;
3259	next if $pic->{'state'} eq "I";
3260	push @res, [ $kw, $pic->{'picid'} ];
3261	}
3262
3263	# now add all the pictures that don't have a keyword
3264	foreach my $picid (keys %{$pi->{'pic'}}) {
3265	my $pic = $pi->{'pic'}{$picid};
3266	next if $seen{$pic};
3267	push @res, [ "pic#$picid", $picid ];
3268	}
3269
3270	return \@res;
3271	}
3272
3273	sub list_moods
3274	{
3275	my $mood_max = int(shift);
3276	LJ::load_moods();
3277
3278	my $res = [];
3279	return $res if $mood_max >= $LJ::CACHED_MOOD_MAX;
3280
3281	for (my $id = $mood_max+1; $id <= $LJ::CACHED_MOOD_MAX; $id++) {
3282	next unless defined $LJ::CACHE_MOODS{$id};
3283	my $mood = $LJ::CACHE_MOODS{$id};
3284	next unless $mood->{'name'};
3285	push @$res, { 'id' => $id,
3286	'name' => $mood->{'name'},
3287	'parent' => $mood->{'parent'} };
3288	}
3289
3290	return $res;
3291	}
3292
3293	sub check_altusage
3294	{
3295	my ($req, $err, $flags) = @_;
3296
3297	# see note in ljlib.pl::can_use_journal about why we return
3298	# both 'ownerid' and 'u_owner' in $flags
3299
3300	my $alt = $req->{'usejournal'};
3301	my $u = $flags->{'u'};
3302	unless ($u) {
3303	my $username = $req->{'username'};
3304	return fail($err,200) unless $username;
3305	return fail($err,100) unless LJ::canonical_username($username);
3306
3307	my $dbr = LJ::get_db_reader();
3308	return fail($err,502) unless $dbr;
3309	$u = $flags->{'u'} = LJ::load_user($username);
3310	}
3311
3312	$flags->{'ownerid'} = $u->{'userid'};
3313
3314	# all good if not using an alt journal
3315	return 1 unless $alt;
3316
3317	# complain if the username is invalid
3318	return fail($err,206) unless LJ::canonical_username($alt);
3319
3320	# allow usage if we're told explicitly that it's okay
3321	if ($flags->{'usejournal_okay'}) {
3322	$flags->{'u_owner'} = LJ::load_user($alt);
3323	$flags->{'ownerid'} = $flags->{'u_owner'}->{'userid'};
3324	LJ::Request->notes("journalid" => $flags->{'ownerid'}) if LJ::Request->is_inited && !LJ::Request->notes("journalid");
3325	return 1 if $flags->{'ownerid'};
3326	return fail($err,206);
3327	}
3328
3329	# otherwise, check for access:
3330	my $info = {};
3331	my $canuse = LJ::can_use_journal($u->{'userid'}, $alt, $info);
3332	$flags->{'ownerid'} = $info->{'ownerid'};
3333	$flags->{'u_owner'} = $info->{'u_owner'};
3334	LJ::Request->notes("journalid" => $flags->{'ownerid'}) if LJ::Request->is_inited && !LJ::Request->notes("journalid");
3335
3336	return 1 if $canuse \|\| $flags->{'ignorecanuse'};
3337
3338	# not allowed to access it
3339	return fail($err,300);
3340	}
3341
3342	sub authenticate
3343	{
3344	my ($req, $err, $flags) = @_;
3345
3346	my $username = $req->{'username'};
3347	return fail($err,200) unless $username;
3348	return fail($err,100) unless LJ::canonical_username($username);
3349
3350	my $u = $flags->{'u'};
3351	unless ($u) {
3352	my $dbr = LJ::get_db_reader();
3353	return fail($err,502) unless $dbr;
3354	$u = LJ::load_user($username);
3355	}
3356
3357	return fail($err,100) unless $u;
3358	return fail($err,100) if ($u->{'statusvis'} eq "X");
3359	return fail($err,505) unless $u->{'clusterid'};
3360
3361	my $ip;
3362	if (LJ::Request->is_inited) {
3363	LJ::Request->notes("ljuser" => $u->{'user'}) unless LJ::Request->notes("ljuser");
3364	LJ::Request->notes("journalid" => $u->{'userid'}) unless LJ::Request->notes("journalid");
3365	$ip = LJ::Request->connection->remote_ip;
3366	}
3367
3368	my $ip_banned = 0;
3369	my $chal_expired = 0;
3370	my $auth_check = sub {
3371
3372	my $auth_meth = $req->{'auth_method'} \|\| "clear";
3373	if ($auth_meth eq "clear") {
3374	return LJ::auth_okay($u,
3375	$req->{'password'},
3376	$req->{'hpassword'},
3377	$u->password,
3378	\$ip_banned);
3379	}
3380	if ($auth_meth eq "challenge") {
3381	my $chal_opts = {};
3382	my $chall_ok = LJ::challenge_check_login($u,
3383	$req->{'auth_challenge'},
3384	$req->{'auth_response'},
3385	\$ip_banned,
3386	$chal_opts);
3387	$chal_expired = 1 if $chal_opts->{expired};
3388	return $chall_ok;
3389	}
3390	if ($auth_meth eq "cookie") {
3391	return unless LJ::Request->is_inited && LJ::Request->header_in("X-LJ-Auth") eq "cookie";
3392	my $remote = LJ::get_remote();
3393	return $remote && $remote->{'user'} eq $username ? 1 : 0;
3394	}
3395	};
3396
3397	unless ($flags->{'nopassword'} \|\|
3398	$flags->{'noauth'} \|\|
3399	$auth_check->() )
3400	{
3401	return fail($err,402) if $ip_banned;
3402	return fail($err,105) if $chal_expired;
3403	return fail($err,101);
3404	}
3405
3406	# if there is a require TOS revision, check for it now
3407	return fail($err, 156, LJ::tosagree_str('protocol' => 'text'))
3408	unless $u->tosagree_verify;
3409
3410	# remember the user record for later.
3411	$flags->{'u'} = $u;
3412	return 1;
3413	}
3414
3415	sub fail
3416	{
3417	my $err = shift;
3418	my $code = shift;
3419	my $des = shift;
3420	$code .= ":$des" if $des;
3421	$$err = $code if (ref $err eq "SCALAR");
3422	return undef;
3423	}
3424
3425	# PROBLEM: a while back we used auto_increment fields in our tables so that we could have
3426	# automatically incremented itemids and such. this was eventually phased out in favor of
3427	# the more portable alloc_user_counter function which uses the 'counter' table. when the
3428	# counter table has no data, it finds the highest id already in use in the database and adds
3429	# one to it.
3430	#
3431	# a problem came about when users who last posted before alloc_user_counter went
3432	# and deleted all their entries and posted anew. alloc_user_counter would find no entries,
3433	# this no ids, and thus assign id 1, thinking it's all clean and new. but, id 1 had been
3434	# used previously, and now has comments attached to it.
3435	#
3436	# the comments would happen because there was an old bug that wouldn't delete comments when
3437	# an entry was deleted. this has since been fixed. so this all combines to make this
3438	# a necessity, at least until no buggy data exist anymore!
3439	#
3440	# this code here removes any comments that happen to exist for the id we're now using.
3441	sub new_entry_cleanup_hack {
3442	my ($u, $jitemid) = @_;
3443
3444	# sanitize input
3445	$jitemid += 0;
3446	return unless $jitemid;
3447	my $ownerid = LJ::want_userid($u);
3448	return unless $ownerid;
3449
3450	# delete logprops
3451	$u->do("DELETE FROM logprop2 WHERE journalid=$ownerid AND jitemid=$jitemid");
3452
3453	# delete comments
3454	my $ids = LJ::Talk::get_talk_data($u, 'L', $jitemid);
3455	return unless ref $ids eq 'HASH' && %$ids;
3456	my $list = join ',', map { $_+0 } keys %$ids;
3457	$u->do("DELETE FROM talk2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
3458	$u->do("DELETE FROM talktext2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
3459	$u->do("DELETE FROM talkprop2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
3460	}
3461
3462	sub un_utf8_request {
3463	my $req = shift;
3464	$req->{$_} = LJ::no_utf8_flag($req->{$_}) foreach qw(subject event);
3465	my $props = $req->{props} \|\| {};
3466	foreach my $k (keys %$props) {
3467	next if ref $props->{$k}; # if this is multiple levels deep? don't think so.
3468	$props->{$k} = LJ::no_utf8_flag($props->{$k});
3469	}
3470	}
3471
3472	#### Old interface (flat key/values) -- wrapper aruond LJ::Protocol
3473	package LJ;
3474
3475	sub do_request
3476	{
3477	# get the request and response hash refs
3478	my ($req, $res, $flags) = @_;
3479
3480	# initialize some stuff
3481	%{$res} = (); # clear the given response hash
3482	$flags = {} unless (ref $flags eq "HASH");
3483
3484	# did they send a mode?
3485	unless ($req->{'mode'}) {
3486	$res->{'success'} = "FAIL";
3487	$res->{'errmsg'} = "Client error: No mode specified.";
3488	return;
3489	}
3490
3491	# this method doesn't require auth
3492	if ($req->{'mode'} eq "getchallenge") {
3493	return getchallenge($req, $res, $flags);
3494	}
3495
3496	# mode from here on out require a username
3497	my $user = LJ::canonical_username($req->{'user'});
3498	unless ($user) {
3499	$res->{'success'} = "FAIL";
3500	$res->{'errmsg'} = "Client error: No username sent.";
3501	return;
3502	}
3503
3504	### see if the server's under maintenance now
3505	if ($LJ::SERVER_DOWN) {
3506	$res->{'success'} = "FAIL";
3507	$res->{'errmsg'} = $LJ::SERVER_DOWN_MESSAGE;
3508	return;
3509	}
3510
3511	## dispatch wrappers
3512	if ($req->{'mode'} eq "login") {
3513	return login($req, $res, $flags);
3514	}
3515	if ($req->{'mode'} eq "getfriendgroups") {
3516	return getfriendgroups($req, $res, $flags);
3517	}
3518	if ($req->{'mode'} eq "getfriends") {
3519	return getfriends($req, $res, $flags);
3520	}
3521	if ($req->{'mode'} eq "friendof") {
3522	return friendof($req, $res, $flags);
3523	}
3524	if ($req->{'mode'} eq "checkfriends") {
3525	return checkfriends($req, $res, $flags);
3526	}
3527	if ($req->{'mode'} eq "getdaycounts") {
3528	return getdaycounts($req, $res, $flags);
3529	}
3530	if ($req->{'mode'} eq "postevent") {
3531	return postevent($req, $res, $flags);
3532	}
3533	if ($req->{'mode'} eq "editevent") {
3534	return editevent($req, $res, $flags);
3535	}
3536	if ($req->{'mode'} eq "syncitems") {
3537	return syncitems($req, $res, $flags);
3538	}
3539	if ($req->{'mode'} eq "getevents") {
3540	return getevents($req, $res, $flags);
3541	}
3542	if ($req->{'mode'} eq "editfriends") {
3543	return editfriends($req, $res, $flags);
3544	}
3545	if ($req->{'mode'} eq "editfriendgroups") {
3546	return editfriendgroups($req, $res, $flags);
3547	}
3548	if ($req->{'mode'} eq "consolecommand") {
3549	return consolecommand($req, $res, $flags);
3550	}
3551	if ($req->{'mode'} eq "sessiongenerate") {
3552	return sessiongenerate($req, $res, $flags);
3553	}
3554	if ($req->{'mode'} eq "sessionexpire") {
3555	return sessionexpire($req, $res, $flags);
3556	}
3557	if ($req->{'mode'} eq "getusertags") {
3558	return getusertags($req, $res, $flags);
3559	}
3560	if ($req->{'mode'} eq "getfriendspage") {
3561	return getfriendspage($req, $res, $flags);
3562	}
3563
3564	### unknown mode!
3565	$res->{'success'} = "FAIL";
3566	$res->{'errmsg'} = "Client error: Unknown mode ($req->{'mode'})";
3567	return;
3568	}
3569
3570	## flat wrapper
3571	sub getfriendspage
3572	{
3573	my ($req, $res, $flags) = @_;
3574
3575	my $err = 0;
3576	my $rq = upgrade_request($req);
3577
3578	my $rs = LJ::Protocol::do_request("getfriendspage", $rq, \$err, $flags);
3579	unless ($rs) {
3580	$res->{'success'} = "FAIL";
3581	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3582	return 0;
3583	}
3584
3585	my $ect = 0;
3586	foreach my $evt (@{$rs->{'entries'}}) {
3587	$ect++;
3588	foreach my $f (qw(subject_raw journalname journaltype postername postertype ditemid security)) {
3589	if (defined $evt->{$f}) {
3590	$res->{"entries_${ect}_$f"} = $evt->{$f};
3591	}
3592	}
3593	$res->{"entries_${ect}_event"} = LJ::eurl($evt->{'event_raw'});
3594	}
3595
3596	$res->{'entries_count'} = $ect;
3597	$res->{'success'} = "OK";
3598
3599	return 1;
3600	}
3601
3602	## flat wrapper
3603	sub login
3604	{
3605	my ($req, $res, $flags) = @_;
3606
3607	my $err = 0;
3608	my $rq = upgrade_request($req);
3609
3610	my $rs = LJ::Protocol::do_request("login", $rq, \$err, $flags);
3611	unless ($rs) {
3612	$res->{'success'} = "FAIL";
3613	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3614	return 0;
3615	}
3616
3617	$res->{'success'} = "OK";
3618	$res->{'name'} = $rs->{'fullname'};
3619	$res->{'message'} = $rs->{'message'} if $rs->{'message'};
3620	$res->{'fastserver'} = 1 if $rs->{'fastserver'};
3621	$res->{'caps'} = $rs->{'caps'} if $rs->{'caps'};
3622
3623	# shared journals
3624	my $access_count = 0;
3625	foreach my $user (@{$rs->{'usejournals'}}) {
3626	$access_count++;
3627	$res->{"access_${access_count}"} = $user;
3628	}
3629	if ($access_count) {
3630	$res->{"access_count"} = $access_count;
3631	}
3632
3633	# friend groups
3634	populate_friend_groups($res, $rs->{'friendgroups'});
3635
3636	my $flatten = sub {
3637	my ($prefix, $listref) = @_;
3638	my $ct = 0;
3639	foreach (@$listref) {
3640	$ct++;
3641	$res->{"${prefix}_$ct"} = $_;
3642	}
3643	$res->{"${prefix}_count"} = $ct;
3644	};
3645
3646	### picture keywords
3647	$flatten->("pickw", $rs->{'pickws'})
3648	if defined $req->{"getpickws"};
3649	$flatten->("pickwurl", $rs->{'pickwurls'})
3650	if defined $req->{"getpickwurls"};
3651	$res->{'defaultpicurl'} = $rs->{'defaultpicurl'} if $rs->{'defaultpicurl'};
3652
3653	### report new moods that this client hasn't heard of, if they care
3654	if (defined $req->{"getmoods"}) {
3655	my $mood_count = 0;
3656	foreach my $m (@{$rs->{'moods'}}) {
3657	$mood_count++;
3658	$res->{"mood_${mood_count}_id"} = $m->{'id'};
3659	$res->{"mood_${mood_count}_name"} = $m->{'name'};
3660	$res->{"mood_${mood_count}_parent"} = $m->{'parent'};
3661	}
3662	if ($mood_count) {
3663	$res->{"mood_count"} = $mood_count;
3664	}
3665	}
3666
3667	#### send web menus
3668	if ($req->{"getmenus"} == 1) {
3669	my $menu = $rs->{'menus'};
3670	my $menu_num = 0;
3671	populate_web_menu($res, $menu, \$menu_num);
3672	}
3673
3674	return 1;
3675	}
3676
3677	## flat wrapper
3678	sub getfriendgroups
3679	{
3680	my ($req, $res, $flags) = @_;
3681
3682	my $err = 0;
3683	my $rq = upgrade_request($req);
3684
3685	my $rs = LJ::Protocol::do_request("getfriendgroups", $rq, \$err, $flags);
3686	unless ($rs) {
3687	$res->{'success'} = "FAIL";
3688	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3689	return 0;
3690	}
3691	$res->{'success'} = "OK";
3692	populate_friend_groups($res, $rs->{'friendgroups'});
3693
3694	return 1;
3695	}
3696
3697	## flat wrapper
3698	sub getusertags
3699	{
3700	my ($req, $res, $flags) = @_;
3701
3702	my $err = 0;
3703	my $rq = upgrade_request($req);
3704
3705	my $rs = LJ::Protocol::do_request("getusertags", $rq, \$err, $flags);
3706	unless ($rs) {
3707	$res->{'success'} = "FAIL";
3708	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3709	return 0;
3710	}
3711
3712	$res->{'success'} = "OK";
3713
3714	my $ct = 0;
3715	foreach my $tag (@{$rs->{tags}}) {
3716	$ct++;
3717	$res->{"tag_${ct}_security"} = $tag->{security_level};
3718	$res->{"tag_${ct}_uses"} = $tag->{uses} if $tag->{uses};
3719	$res->{"tag_${ct}_display"} = $tag->{display} if $tag->{display};
3720	$res->{"tag_${ct}_name"} = $tag->{name};
3721	foreach my $lev (qw(friends private public)) {
3722	$res->{"tag_${ct}_sb_$_"} = $tag->{security}->{$_}
3723	if $tag->{security}->{$_};
3724	}
3725	my $gm = 0;
3726	foreach my $grpid (keys %{$tag->{security}->{groups}}) {
3727	next unless $tag->{security}->{groups}->{$grpid};
3728	$gm++;
3729	$res->{"tag_${ct}_sb_group_${gm}_id"} = $grpid;
3730	$res->{"tag_${ct}_sb_group_${gm}_count"} = $tag->{security}->{groups}->{$grpid};
3731	}
3732	$res->{"tag_${ct}_sb_group_count"} = $gm if $gm;
3733	}
3734	$res->{'tag_count'} = $ct;
3735
3736	return 1;
3737	}
3738
3739	## flat wrapper
3740	sub getfriends
3741	{
3742	my ($req, $res, $flags) = @_;
3743
3744	my $err = 0;
3745	my $rq = upgrade_request($req);
3746
3747	my $rs = LJ::Protocol::do_request("getfriends", $rq, \$err, $flags);
3748	unless ($rs) {
3749	$res->{'success'} = "FAIL";
3750	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3751	return 0;
3752	}
3753
3754	$res->{'success'} = "OK";
3755	if ($req->{'includegroups'}) {
3756	populate_friend_groups($res, $rs->{'friendgroups'});
3757	}
3758	if ($req->{'includefriendof'}) {
3759	populate_friends($res, "friendof", $rs->{'friendofs'});
3760	}
3761	populate_friends($res, "friend", $rs->{'friends'});
3762
3763	return 1;
3764	}
3765
3766	## flat wrapper
3767	sub friendof
3768	{
3769	my ($req, $res, $flags) = @_;
3770
3771	my $err = 0;
3772	my $rq = upgrade_request($req);
3773
3774	my $rs = LJ::Protocol::do_request("friendof", $rq, \$err, $flags);
3775	unless ($rs) {
3776	$res->{'success'} = "FAIL";
3777	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3778	return 0;
3779	}
3780
3781	$res->{'success'} = "OK";
3782	populate_friends($res, "friendof", $rs->{'friendofs'});
3783	return 1;
3784	}
3785
3786	## flat wrapper
3787	sub checkfriends
3788	{
3789	my ($req, $res, $flags) = @_;
3790
3791	my $err = 0;
3792	my $rq = upgrade_request($req);
3793
3794	my $rs = LJ::Protocol::do_request("checkfriends", $rq, \$err, $flags);
3795	unless ($rs) {
3796	$res->{'success'} = "FAIL";
3797	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3798	return 0;
3799	}
3800
3801	$res->{'success'} = "OK";
3802	$res->{'new'} = $rs->{'new'};
3803	$res->{'lastupdate'} = $rs->{'lastupdate'};
3804	$res->{'interval'} = $rs->{'interval'};
3805	return 1;
3806	}
3807
3808	## flat wrapper
3809	sub getdaycounts
3810	{
3811	my ($req, $res, $flags) = @_;
3812
3813	my $err = 0;
3814	my $rq = upgrade_request($req);
3815
3816	my $rs = LJ::Protocol::do_request("getdaycounts", $rq, \$err, $flags);
3817	unless ($rs) {
3818	$res->{'success'} = "FAIL";
3819	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3820	return 0;
3821	}
3822
3823	$res->{'success'} = "OK";
3824	foreach my $d (@{ $rs->{'daycounts'} }) {
3825	$res->{$d->{'date'}} = $d->{'count'};
3826	}
3827	return 1;
3828	}
3829
3830	## flat wrapper
3831	sub syncitems
3832	{
3833	my ($req, $res, $flags) = @_;
3834
3835	my $err = 0;
3836	my $rq = upgrade_request($req);
3837
3838	my $rs = LJ::Protocol::do_request("syncitems", $rq, \$err, $flags);
3839	unless ($rs) {
3840	$res->{'success'} = "FAIL";
3841	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3842	return 0;
3843	}
3844
3845	$res->{'success'} = "OK";
3846	$res->{'sync_total'} = $rs->{'total'};
3847	$res->{'sync_count'} = $rs->{'count'};
3848
3849	my $ct = 0;
3850	foreach my $s (@{ $rs->{'syncitems'} }) {
3851	$ct++;
3852	foreach my $a (qw(item action time)) {
3853	$res->{"sync_${ct}_$a"} = $s->{$a};
3854	}
3855	}
3856	return 1;
3857	}
3858
3859	## flat wrapper: limited functionality. (1 command only, server-parsed only)
3860	sub consolecommand
3861	{
3862	my ($req, $res, $flags) = @_;
3863
3864	my $err = 0;
3865	my $rq = upgrade_request($req);
3866	delete $rq->{'command'};
3867
3868	$rq->{'commands'} = [ $req->{'command'} ];
3869
3870	my $rs = LJ::Protocol::do_request("consolecommand", $rq, \$err, $flags);
3871	unless ($rs) {
3872	$res->{'success'} = "FAIL";
3873	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3874	return 0;
3875	}
3876
3877	$res->{'cmd_success'} = $rs->{'results'}->[0]->{'success'};
3878	$res->{'cmd_line_count'} = 0;
3879	foreach my $l (@{$rs->{'results'}->[0]->{'output'}}) {
3880	$res->{'cmd_line_count'}++;
3881	my $line = $res->{'cmd_line_count'};
3882	$res->{"cmd_line_${line}_type"} = $l->[0]
3883	if $l->[0];
3884	$res->{"cmd_line_${line}"} = $l->[1];
3885	}
3886
3887	$res->{'success'} = "OK";
3888
3889	}
3890
3891	## flat wrapper
3892	sub getchallenge
3893	{
3894	my ($req, $res, $flags) = @_;
3895	my $err = 0;
3896	my $rs = LJ::Protocol::do_request("getchallenge", $req, \$err, $flags);
3897
3898	# stupid copy (could just return $rs), but it might change in the future
3899	# so this protects us from future accidental harm.
3900	foreach my $k (qw(challenge server_time expire_time auth_scheme)) {
3901	$res->{$k} = $rs->{$k};
3902	}
3903
3904	$res->{'success'} = "OK";
3905	return $res;
3906	}
3907
3908	## flat wrapper
3909	sub editfriends
3910	{
3911	my ($req, $res, $flags) = @_;
3912
3913	my $err = 0;
3914	my $rq = upgrade_request($req);
3915
3916	$rq->{'add'} = [];
3917	$rq->{'delete'} = [];
3918
3919	foreach (keys %$req) {
3920	if (/^editfriend_add_(\d+)_user$/) {
3921	my $n = $1;
3922	next unless ($req->{"editfriend_add_${n}_user"} =~ /\S/);
3923	my $fa = { 'username' => $req->{"editfriend_add_${n}_user"},
3924	'fgcolor' => $req->{"editfriend_add_${n}_fg"},
3925	'bgcolor' => $req->{"editfriend_add_${n}_bg"},
3926	'groupmask' => $req->{"editfriend_add_${n}_groupmask"},
3927	};
3928	push @{$rq->{'add'}}, $fa;
3929	} elsif (/^editfriend_delete_(\w+)$/) {
3930	push @{$rq->{'delete'}}, $1;
3931	}
3932	}
3933
3934	my $rs = LJ::Protocol::do_request("editfriends", $rq, \$err, $flags);
3935	unless ($rs) {
3936	$res->{'success'} = "FAIL";
3937	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3938	return 0;
3939	}
3940
3941	$res->{'success'} = "OK";
3942
3943	my $ct = 0;
3944	foreach my $fa (@{ $rs->{'added'} }) {
3945	$ct++;
3946	$res->{"friend_${ct}_user"} = $fa->{'username'};
3947	$res->{"friend_${ct}_name"} = $fa->{'fullname'};
3948	}
3949
3950	$res->{'friends_added'} = $ct;
3951
3952	return 1;
3953	}
3954
3955	## flat wrapper
3956	sub editfriendgroups
3957	{
3958	my ($req, $res, $flags) = @_;
3959
3960	my $err = 0;
3961	my $rq = upgrade_request($req);
3962
3963	$rq->{'groupmasks'} = {};
3964	$rq->{'set'} = {};
3965	$rq->{'delete'} = [];
3966
3967	foreach (keys %$req) {
3968	if (/^efg_set_(\d+)_name$/) {
3969	next unless ($req->{$_} ne "");
3970	my $n = $1;
3971	my $fs = {
3972	'name' => $req->{"efg_set_${n}_name"},
3973	'sort' => $req->{"efg_set_${n}_sort"},
3974	};
3975	if (defined $req->{"efg_set_${n}_public"}) {
3976	$fs->{'public'} = $req->{"efg_set_${n}_public"};
3977	}
3978	$rq->{'set'}->{$n} = $fs;
3979	}
3980	elsif (/^efg_delete_(\d+)$/) {
3981	if ($req->{$_}) {
3982	# delete group if value is true
3983	push @{$rq->{'delete'}}, $1;
3984	}
3985	}
3986	elsif (/^editfriend_groupmask_(\w+)$/) {
3987	$rq->{'groupmasks'}->{$1} = $req->{$_};
3988	}
3989	}
3990
3991	my $rs = LJ::Protocol::do_request("editfriendgroups", $rq, \$err, $flags);
3992	unless ($rs) {
3993	$res->{'success'} = "FAIL";
3994	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3995	return 0;
3996	}
3997
3998	$res->{'success'} = "OK";
3999	return 1;
4000	}
4001
4002	sub flatten_props
4003	{
4004	my ($req, $rq) = @_;
4005
4006	## changes prop_* to props hashref
4007	foreach my $k (keys %$req) {
4008	next unless ($k =~ /^prop_(.+)/);
4009	$rq->{'props'}->{$1} = $req->{$k};
4010	}
4011	}
4012
4013	## flat wrapper
4014	sub postevent
4015	{
4016	my ($req, $res, $flags) = @_;
4017
4018	my $err = 0;
4019	my $rq = upgrade_request($req);
4020	flatten_props($req, $rq);
4021	$rq->{'props'}->{'interface'} = "flat";
4022
4023	my $rs = LJ::Protocol::do_request("postevent", $rq, \$err, $flags);
4024	unless ($rs) {
4025	$res->{'success'} = "FAIL";
4026	$res->{'errmsg'} = LJ::Protocol::error_message($err);
4027	return 0;
4028	}
4029
4030	$res->{'message'} = $rs->{'message'} if $rs->{'message'};
4031	$res->{'extra_result_message'} = $rs->{'extra_result_message'} if $rs->{'extra_result_message'};
4032	$res->{'success'} = "OK";
4033	$res->{'itemid'} = $rs->{'itemid'};
4034	$res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
4035	$res->{'url'} = $rs->{'url'} if defined $rs->{'url'};
4036	# we may not translate 'warnings' here, because it may contain \n characters
4037	return 1;
4038	}
4039
4040	## flat wrapper
4041	sub editevent
4042	{
4043	my ($req, $res, $flags) = @_;
4044
4045	my $err = 0;
4046	my $rq = upgrade_request($req);
4047	flatten_props($req, $rq);
4048
4049	my $rs = LJ::Protocol::do_request("editevent", $rq, \$err, $flags);
4050	unless ($rs) {
4051	$res->{'success'} = "FAIL";
4052	$res->{'errmsg'} = LJ::Protocol::error_message($err);
4053	return 0;
4054	}
4055
4056	$res->{'success'} = "OK";
4057	$res->{'itemid'} = $rs->{'itemid'};
4058	$res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
4059	$res->{'url'} = $rs->{'url'} if defined $rs->{'url'};
4060	return 1;
4061	}
4062
4063	## flat wrapper
4064	sub sessiongenerate {
4065	my ($req, $res, $flags) = @_;
4066
4067	my $err = 0;
4068	my $rq = upgrade_request($req);
4069
4070	my $rs = LJ::Protocol::do_request('sessiongenerate', $rq, \$err, $flags);
4071	unless ($rs) {
4072	$res->{success} = 'FAIL';
4073	$res->{errmsg} = LJ::Protocol::error_message($err);
4074	}
4075
4076	$res->{success} = 'OK';
4077	$res->{ljsession} = $rs->{ljsession};
4078	return 1;
4079	}
4080
4081	## flat wrappre
4082	sub sessionexpire {
4083	my ($req, $res, $flags) = @_;
4084
4085	my $err = 0;
4086	my $rq = upgrade_request($req);
4087
4088	$rq->{expire} = [];
4089	foreach my $k (keys %$rq) {
4090	push @{$rq->{expire}}, $1
4091	if $k =~ /^expire_id_(\d+)$/;
4092	}
4093
4094	my $rs = LJ::Protocol::do_request('sessionexpire', $rq, \$err, $flags);
4095	unless ($rs) {
4096	$res->{success} = 'FAIL';
4097	$res->{errmsg} = LJ::Protocol::error_message($err);
4098	}
4099
4100	$res->{success} = 'OK';
4101	return 1;
4102	}
4103
4104	## flat wrapper
4105	sub getevents
4106	{
4107	my ($req, $res, $flags) = @_;
4108
4109	my $err = 0;
4110	my $rq = upgrade_request($req);
4111
4112	my $rs = LJ::Protocol::do_request("getevents", $rq, \$err, $flags);
4113	unless ($rs) {
4114	$res->{'success'} = "FAIL";
4115	$res->{'errmsg'} = LJ::Protocol::error_message($err);
4116	return 0;
4117	}
4118
4119	my $ect = 0;
4120	my $pct = 0;
4121	foreach my $evt (@{$rs->{'events'}}) {
4122	$ect++;
4123	foreach my $f (qw(itemid eventtime security allowmask subject anum url poster)) {
4124	if (defined $evt->{$f}) {
4125	$res->{"events_${ect}_$f"} = $evt->{$f};
4126	}
4127	}
4128	$res->{"events_${ect}_event"} = LJ::eurl($evt->{'event'});
4129
4130	if ($evt->{'props'}) {
4131	foreach my $k (sort keys %{$evt->{'props'}}) {
4132	$pct++;
4133	$res->{"prop_${pct}_itemid"} = $evt->{'itemid'};
4134	$res->{"prop_${pct}_name"} = $k;
4135	$res->{"prop_${pct}_value"} = $evt->{'props'}->{$k};
4136	}
4137	}
4138	}
4139
4140	unless ($req->{'noprops'}) {
4141	$res->{'prop_count'} = $pct;
4142	}
4143	$res->{'events_count'} = $ect;
4144	$res->{'success'} = "OK";
4145
4146	return 1;
4147	}
4148
4149
4150	sub populate_friends
4151	{
4152	my ($res, $pfx, $list) = @_;
4153	my $count = 0;
4154	foreach my $f (@$list)
4155	{
4156	$count++;
4157	$res->{"${pfx}_${count}_name"} = $f->{'fullname'};
4158	$res->{"${pfx}_${count}_user"} = $f->{'username'};
4159	$res->{"${pfx}_${count}_birthday"} = $f->{'birthday'} if $f->{'birthday'};
4160	$res->{"${pfx}_${count}_bg"} = $f->{'bgcolor'};
4161	$res->{"${pfx}_${count}_fg"} = $f->{'fgcolor'};
4162	if (defined $f->{'groupmask'}) {
4163	$res->{"${pfx}_${count}_groupmask"} = $f->{'groupmask'};
4164	}
4165	if (defined $f->{'type'}) {
4166	$res->{"${pfx}_${count}_type"} = $f->{'type'};
4167	if ($f->{'type'} eq 'identity') {
4168	$res->{"${pfx}_${count}_identity_type"} = $f->{'identity_type'};
4169	$res->{"${pfx}_${count}_identity_value"} = $f->{'identity_value'};
4170	$res->{"${pfx}_${count}_identity_display"} = $f->{'identity_display'};
4171	}
4172	}
4173	if (defined $f->{'status'}) {
4174	$res->{"${pfx}_${count}_status"} = $f->{'status'};
4175	}
4176	}
4177	$res->{"${pfx}_count"} = $count;
4178	}
4179
4180
4181	sub upgrade_request
4182	{
4183	my $r = shift;
4184	my $new = { %{ $r } };
4185	$new->{'username'} = $r->{'user'};
4186
4187	# but don't delete $r->{'user'}, as it might be, say, %FORM,
4188	# that'll get reused in a later request in, say, update.bml after
4189	# the login before postevent. whoops.
4190
4191	return $new;
4192	}
4193
4194	## given a $res hashref and friend group subtree (arrayref), flattens it
4195	sub populate_friend_groups
4196	{
4197	my ($res, $fr) = @_;
4198
4199	my $maxnum = 0;
4200	foreach my $fg (@$fr)
4201	{
4202	my $num = $fg->{'id'};
4203	$res->{"frgrp_${num}_name"} = $fg->{'name'};
4204	$res->{"frgrp_${num}_sortorder"} = $fg->{'sortorder'};
4205	if ($fg->{'public'}) {
4206	$res->{"frgrp_${num}_public"} = 1;
4207	}
4208	if ($num > $maxnum) { $maxnum = $num; }
4209	}
4210	$res->{'frgrp_maxnum'} = $maxnum;
4211	}
4212
4213	## given a menu tree, flattens it into $res hashref
4214	sub populate_web_menu
4215	{
4216	my ($res, $menu, $numref) = @_;
4217	my $mn = $$numref; # menu number
4218	my $mi = 0; # menu item
4219	foreach my $it (@$menu) {
4220	$mi++;
4221	$res->{"menu_${mn}_${mi}_text"} = $it->{'text'};
4222	if ($it->{'text'} eq "-") { next; }
4223	if ($it->{'sub'}) {
4224	$$numref++;
4225	$res->{"menu_${mn}_${mi}_sub"} = $$numref;
4226	&populate_web_menu($res, $it->{'sub'}, $numref);
4227	next;
4228
4229	}
4230	$res->{"menu_${mn}_${mi}_url"} = $it->{'url'};
4231	}
4232	$res->{"menu_${mn}_count"} = $mi;
4233	}
4234
4235	1;

Note: See TracBrowser for help on using the browser.

Context Navigation

root/trunk/cgi-bin/ljprotocol.pl

Download in other formats: