Context Navigation

ljprotocol.pl

Visit:

Revision 16331, 143.7 KB (checked in by aurbanowich, 7 days ago)
LJSUP-5536
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	# only people should have unknown8bit entries.
1046	my $uowner = $flags->{u_owner} \|\| $flags->{u};
1047	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/.')
1048	if $uowner->{journaltype} ne 'P';
1049
1050	# so rest of site can change chars to ? marks until
1051	# default user's encoding is set. (legacy support)
1052	$req->{'props'}->{'unknown8bit'} = 1;
1053	} else {
1054	return fail($err,207, "This installation does not support Unicode clients") unless $LJ::UNICODE;
1055	# validate that the text is valid UTF-8
1056	if (!LJ::text_in($req->{'subject'}) \|\|
1057	!LJ::text_in($req->{'event'}) \|\|
1058	grep { !LJ::text_in($_) } values %{$req->{'props'}}) {
1059	return fail($err, 208, "The text entered is not a valid UTF-8 stream");
1060	}
1061	}
1062	}
1063
1064	## handle meta-data (properties)
1065	LJ::load_props("log");
1066	foreach my $pname (keys %{$req->{'props'}})
1067	{
1068	my $p = LJ::get_prop("log", $pname);
1069
1070	# does the property even exist?
1071	unless ($p) {
1072	$pname =~ s/[^\w]//g;
1073	return fail($err,205,$pname);
1074	}
1075
1076	# don't validate its type if it's 0 or undef (deleting)
1077	next unless ($req->{'props'}->{$pname});
1078
1079	my $ptype = $p->{'datatype'};
1080	my $val = $req->{'props'}->{$pname};
1081
1082	if ($ptype eq "bool" && $val !~ /^[01]$/) {
1083	return fail($err,204,"Property \"$pname\" should be 0 or 1");
1084	}
1085	if ($ptype eq "num" && $val =~ /[^\d]/) {
1086	return fail($err,204,"Property \"$pname\" should be numeric");
1087	}
1088	if ($pname eq "current_coords" && ! eval { LJ::Location->new(coords => $val) }) {
1089	return fail($err,204,"Property \"current_coords\" has invalid value");
1090	}
1091	}
1092
1093	# check props for inactive userpic
1094	if (my $pickwd = $req->{'props'}->{'picture_keyword'}) {
1095	my $pic = LJ::get_pic_from_keyword($flags->{'u'}, $pickwd);
1096
1097	# need to make sure they aren't trying to post with an inactive keyword, but also
1098	# we don't want to allow them to post with a keyword that has no pic at all to prevent
1099	# them from deleting the keyword, posting, then adding it back with editpics.bml
1100	delete $req->{'props'}->{'picture_keyword'} if ! $pic \|\| $pic->{'state'} eq 'I';
1101	}
1102
1103	# validate incoming list of tags
1104	return fail($err, 211)
1105	if $req->{props}->{taglist} &&
1106	! LJ::Tags::is_valid_tagstring($req->{props}->{taglist});
1107
1108	return 1;
1109	}
1110
1111	sub postevent
1112	{
1113	my ($req, $err, $flags) = @_;
1114	un_utf8_request($req);
1115
1116	my $post_noauth = LJ::run_hook('post_noauth', $req);
1117	return undef unless $post_noauth \|\| authenticate($req, $err, $flags);
1118
1119	my $spam = 0;
1120	LJ::run_hook('spam_detector', $req, \$spam);
1121	return fail($err,320) if $spam;
1122
1123	# if going through mod queue, then we know they're permitted to post at least this entry
1124	$flags->{'usejournal_okay'} = 1 if $post_noauth;
1125	return undef unless check_altusage($req, $err, $flags) \|\| $flags->{nomod};
1126
1127	my $u = $flags->{'u'};
1128	my $ownerid = $flags->{'ownerid'}+0;
1129	my $uowner = $flags->{'u_owner'} \|\| $u;
1130	# Make sure we have a real user object here
1131	$uowner = LJ::want_user($uowner) unless LJ::isu($uowner);
1132	my $clusterid = $uowner->{'clusterid'};
1133
1134	my $dbh = LJ::get_db_writer();
1135	my $dbcm = LJ::get_cluster_master($uowner);
1136
1137	return fail($err,306) unless $dbh && $dbcm && $uowner->writer;
1138	return fail($err,200) unless $req->{'event'} =~ /\S/;
1139
1140	### make sure community, shared, or news journals don't post
1141	### note: shared and news journals are deprecated. every shared journal
1142	## should one day be a community journal, of some form.
1143	return fail($err,150) if ($u->{'journaltype'} eq "C" \|\|
1144	$u->{'journaltype'} eq "S" \|\|
1145	$u->{'journaltype'} eq "I" \|\|
1146	$u->{'journaltype'} eq "N");
1147
1148	# underage users can't do this
1149	return fail($err,310) if $u->underage;
1150
1151	# suspended users can't post
1152	return fail($err,305) if ($u->{'statusvis'} eq "S");
1153
1154	# memorials can't post
1155	return fail($err,309) if $u->{statusvis} eq 'M';
1156
1157	# locked accounts can't post
1158	return fail($err,308) if $u->{statusvis} eq 'L';
1159
1160	# check the journal's read-only bit
1161	return fail($err,306) if LJ::get_cap($uowner, "readonly");
1162
1163	# is the user allowed to post?
1164	return fail($err,404,$LJ::MSG_NO_POST) unless LJ::get_cap($u, "can_post");
1165
1166	# is the user allowed to post?
1167	return fail($err,410) if LJ::get_cap($u, "disable_can_post");
1168
1169	# read-only accounts can't post
1170	return fail($err,316) if $u->is_readonly;
1171
1172	# read-only accounts can't be posted to
1173	return fail($err,317) if $uowner->is_readonly;
1174
1175	# can't post to deleted/suspended community
1176	return fail($err,307) unless $uowner->{'statusvis'} eq "V";
1177
1178	# user must have a validated email address to post to any journal - including its own,
1179	# except syndicated (rss, 'Y') journals
1180	# unless this is approved from the mod queue (we'll error out initially, but in case they change later)
1181	return fail($err, 155, "You must have an authenticated email address in order to post to another account")
1182	unless $u->{'status'} eq 'A' \|\| $u->{'journaltype'} eq 'Y';
1183
1184	$req->{'event'} =~ s/\r\n/\n/g; # compact new-line endings to more comfort chars count near 65535 limit
1185
1186	# post content too large
1187	# NOTE: requires $req->{event} be binary data, but we've already
1188	# removed the utf-8 flag in the XML-RPC path, and it never gets
1189	# set in the "flat" protocol path.
1190	return fail($err,409) if length($req->{'event'}) >= LJ::BMAX_EVENT;
1191
1192	my $time_was_faked = 0;
1193	my $offset = 0; # assume gmt at first.
1194
1195	if (defined $req->{'tz'}) {
1196	if ($req->{tz} eq 'guess') {
1197	LJ::get_timezone($u, \$offset, \$time_was_faked);
1198	} elsif ($req->{'tz'} =~ /^[+\-]\d\d\d\d$/) {
1199	# FIXME we ought to store this timezone and make use of it somehow.
1200	$offset = $req->{'tz'} / 100.0;
1201	} else {
1202	return fail($err, 203, "Invalid tz");
1203	}
1204	}
1205
1206	if (defined $req->{'tz'} and not grep { defined $req->{$_} } qw(year mon day hour min)) {
1207	my @ltime = gmtime(time() + ($offset*3600));
1208	$req->{'year'} = $ltime[5]+1900;
1209	$req->{'mon'} = $ltime[4]+1;
1210	$req->{'day'} = $ltime[3];
1211	$req->{'hour'} = $ltime[2];
1212	$req->{'min'} = $ltime[1];
1213	$time_was_faked = 1;
1214	}
1215
1216	return undef
1217	unless common_event_validation($req, $err, $flags);
1218
1219	# confirm we can add tags, at least
1220	return fail($err, 312)
1221	if $req->{props} && $req->{props}->{taglist} &&
1222	! LJ::Tags::can_add_tags($uowner, $u);
1223
1224	my $event = $req->{'event'};
1225
1226	### allow for posting to journals that aren't yours (if you have permission)
1227	my $posterid = $u->{'userid'}+0;
1228
1229	# make the proper date format
1230	my $eventtime = sprintf("%04d-%02d-%02d %02d:%02d",
1231	$req->{'year'}, $req->{'mon'},
1232	$req->{'day'}, $req->{'hour'},
1233	$req->{'min'});
1234	my $qeventtime = $dbh->quote($eventtime);
1235
1236	# load userprops all at once
1237	my @poster_props = qw(newesteventtime dupsig_post);
1238	my @owner_props = qw(newpost_minsecurity moderated);
1239	push @owner_props, 'opt_weblogscom' unless $req->{'props'}->{'opt_backdated'};
1240
1241	LJ::load_user_props($u, @poster_props, @owner_props);
1242	if ($uowner->{'userid'} == $u->{'userid'}) {
1243	$uowner->{$_} = $u->{$_} foreach (@owner_props);
1244	} else {
1245	LJ::load_user_props($uowner, @owner_props);
1246	}
1247
1248	# are they trying to post back in time?
1249	if ($posterid == $ownerid && $u->{'journaltype'} ne 'Y' &&
1250	!$time_was_faked && $u->{'newesteventtime'} &&
1251	$eventtime lt $u->{'newesteventtime'} &&
1252	!$req->{'props'}->{'opt_backdated'}) {
1253	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.");
1254	}
1255
1256	my $qallowmask = $req->{'allowmask'}+0;
1257	my $security = "public";
1258	my $uselogsec = 0;
1259	if ($req->{'security'} eq "usemask" \|\| $req->{'security'} eq "private") {
1260	$security = $req->{'security'};
1261	}
1262	if ($req->{'security'} eq "usemask") {
1263	$uselogsec = 1;
1264	}
1265
1266	# can't specify both a custom security and 'friends-only'
1267	return fail($err, 203, "Invalid friends group security set")
1268	if $qallowmask > 1 && $qallowmask % 2;
1269
1270	## if newpost_minsecurity is set, new entries have to be
1271	## a minimum security level
1272	$security = "private"
1273	if $uowner->newpost_minsecurity eq "private";
1274	($security, $qallowmask) = ("usemask", 1)
1275	if $uowner->newpost_minsecurity eq "friends"
1276	and $security eq "public";
1277
1278	my $qsecurity = $dbh->quote($security);
1279
1280	### make sure user can't post with "custom/private security" on shared journals
1281	return fail($err,102)
1282	if ($ownerid != $posterid && # community post
1283	($req->{'security'} eq "private" \|\|
1284	($req->{'security'} eq "usemask" && $qallowmask != 1 )));
1285
1286	# make sure this user isn't banned from posting here (if
1287	# this is a community journal)
1288	return fail($err,151) if
1289	LJ::is_banned($posterid, $ownerid);
1290
1291	# don't allow backdated posts in communities
1292	return fail($err,152) if
1293	($req->{'props'}->{"opt_backdated"} &&
1294	$uowner->{'journaltype'} ne "P");
1295
1296	# do processing of embedded polls (doesn't add to database, just
1297	# does validity checking)
1298	my @polls = ();
1299	if (LJ::Poll->contains_new_poll(\$event))
1300	{
1301	return fail($err,301,"Your account type doesn't permit creating polls.")
1302	unless (LJ::get_cap($u, "makepoll")
1303	\|\| ($uowner->{'journaltype'} eq "C"
1304	&& LJ::get_cap($uowner, "makepoll")
1305	&& LJ::can_manage_other($u, $uowner)));
1306
1307	my $error = "";
1308	@polls = LJ::Poll->new_from_html(\$event, \$error, {
1309	'journalid' => $ownerid,
1310	'posterid' => $posterid,
1311	});
1312	return fail($err,103,$error) if $error;
1313	}
1314
1315	# convert RTE lj-embeds to normal lj-embeds
1316	$event = LJ::EmbedModule->transform_rte_post($event);
1317
1318	# process module embedding
1319	LJ::EmbedModule->parse_module_embed($uowner, \$event);
1320
1321	my $now = $dbcm->selectrow_array("SELECT UNIX_TIMESTAMP()");
1322	my $anum = int(rand(256));
1323
1324	# by default we record the true reverse time that the item was entered.
1325	# however, if backdate is on, we put the reverse time at the end of time
1326	# (which makes it equivalent to 1969, but get_recent_items will never load
1327	# it... where clause there is: < $LJ::EndOfTime). but this way we can
1328	# have entries that don't show up on friends view, now that we don't have
1329	# the hints table to not insert into.
1330	my $rlogtime = $LJ::EndOfTime;
1331	unless ($req->{'props'}->{"opt_backdated"}) {
1332	$rlogtime -= $now;
1333	}
1334
1335	my $dupsig = Digest::MD5::md5_hex(join('', map { $req->{$_} }
1336	qw(subject event usejournal security allowmask)));
1337	my $lock_key = "post-$ownerid";
1338
1339	# release our duplicate lock
1340	my $release = sub { $dbcm->do("SELECT RELEASE_LOCK(?)", undef, $lock_key); };
1341
1342	# our own local version of fail that releases our lock first
1343	my $fail = sub { $release->(); return fail(@_); };
1344
1345	my $res = {};
1346	my $res_done = 0; # set true by getlock when post was duplicate, or error getting lock
1347
1348	my $getlock = sub {
1349	my $r = $dbcm->selectrow_array("SELECT GET_LOCK(?, 2)", undef, $lock_key);
1350	unless ($r) {
1351	$res = undef; # a failure case has an undef result
1352	fail($err,503); # set error flag to "can't get lock";
1353	$res_done = 1; # tell caller to bail out
1354	return;
1355	}
1356	my @parts = split(/:/, $u->{'dupsig_post'});
1357	if ($parts[0] eq $dupsig) {
1358	# duplicate! let's make the client think this was just the
1359	# normal first response.
1360	$res->{'itemid'} = $parts[1];
1361	$res->{'anum'} = $parts[2];
1362
1363	my $dup_entry = LJ::Entry->new($uowner, jitemid => $res->{'itemid'}, anum => $res->{'anum'});
1364	$res->{'url'} = $dup_entry->url;
1365
1366	$res_done = 1;
1367	$release->();
1368	}
1369	};
1370
1371	my $need_moderated = ( $uowner->{'moderated'} =~ /^[1A]$/ ) ? 1 : 0;
1372	if ( $uowner->{'moderated'} eq 'F' ) {
1373	## Scan post for spam
1374	LJ::run_hook('spam_community_detector', $uowner, $req, \$need_moderated);
1375	}
1376	# if posting to a moderated community, store and bail out here
1377	if ($uowner->{'journaltype'} eq 'C' && $need_moderated && !$flags->{'nomod'}) {
1378	# don't moderate admins, moderators & pre-approved users
1379	my $dbh = LJ::get_db_writer();
1380	my $relcount = $dbh->selectrow_array("SELECT COUNT(*) FROM reluser ".
1381	"WHERE userid=$ownerid AND targetid=$posterid ".
1382	"AND type IN ('A','M','N')");
1383	unless ($relcount) {
1384	# moderation queue full?
1385	my $modcount = $dbcm->selectrow_array("SELECT COUNT(*) FROM modlog WHERE journalid=$ownerid");
1386	return fail($err, 407) if $modcount >= LJ::get_cap($uowner, "mod_queue");
1387
1388	$modcount = $dbcm->selectrow_array("SELECT COUNT(*) FROM modlog ".
1389	"WHERE journalid=$ownerid AND posterid=$posterid");
1390	return fail($err, 408) if $modcount >= LJ::get_cap($uowner, "mod_queue_per_poster");
1391
1392	$req->{'_moderate'}->{'authcode'} = LJ::make_auth_code(15);
1393
1394	# create tag <lj-embed> from HTML-tag <embed>
1395	LJ::EmbedModule->parse_module_embed($uowner, \$req->{event});
1396
1397	my $fr = $dbcm->quote(Storable::freeze($req));
1398	return fail($err, 409) if length($fr) > 200_000;
1399
1400	# store
1401	my $modid = LJ::alloc_user_counter($uowner, "M");
1402	return fail($err, 501) unless $modid;
1403
1404	$uowner->do("INSERT INTO modlog (journalid, modid, posterid, subject, logtime) ".
1405	"VALUES ($ownerid, $modid, $posterid, ?, NOW())", undef,
1406	LJ::text_trim($req->{'subject'}, 30, 0));
1407	return fail($err, 501) if $uowner->err;
1408
1409	$uowner->do("INSERT INTO modblob (journalid, modid, request_stor) ".
1410	"VALUES ($ownerid, $modid, $fr)");
1411	if ($uowner->err) {
1412	$uowner->do("DELETE FROM modlog WHERE journalid=$ownerid AND modid=$modid");
1413	return fail($err, 501);
1414	}
1415
1416	# alert moderator(s)
1417	my $mods = LJ::load_rel_user($dbh, $ownerid, 'M') \|\| [];
1418	if (@$mods) {
1419	# load up all these mods and figure out if they want email or not
1420	my $modlist = LJ::load_userids(@$mods);
1421
1422	my @emails;
1423	my $ct;
1424	foreach my $mod (values %$modlist) {
1425	last if $ct > 20; # don't send more than 20 emails.
1426
1427	next unless $mod->is_visible;
1428
1429	LJ::load_user_props($mod, 'opt_nomodemail');
1430	next if $mod->{opt_nomodemail};
1431	next if $mod->{status} ne "A";
1432
1433	push @emails,
1434	{
1435	to => $mod->email_raw,
1436	browselang => $mod->prop('browselang'),
1437	charset => $mod->mailencoding \|\| 'utf-8',
1438	};
1439
1440	++$ct;
1441	}
1442
1443	foreach my $to (@emails) {
1444	# TODO: html/plain text.
1445	my $body = LJ::Lang::get_text(
1446	$to->{'browselang'},
1447	'esn.moderated_submission.body', undef,
1448	{
1449	user => $u->{'user'},
1450	subject => $req->{'subject'},
1451	community => $uowner->{'user'},
1452	modid => $modid,
1453	siteroot => $LJ::SITEROOT,
1454	sitename => $LJ::SITENAME,
1455	moderateurl => "$LJ::SITEROOT/community/moderate.bml?authas=$uowner->{'user'}&modid=$modid",
1456	viewurl => "$LJ::SITEROOT/community/moderate.bml?authas=$uowner->{'user'}",
1457	});
1458
1459	my $subject = LJ::Lang::get_text($to->{'browselang'},'esn.moderated_submission.subject');
1460
1461	LJ::send_mail({
1462	'to' => $to->{to},
1463	'from' => $LJ::ADMIN_EMAIL,
1464	'charset' => $to->{charset},
1465	'subject' => $subject,
1466	'body' => $body,
1467	});
1468	}
1469	}
1470
1471	my $msg = translate($u, "modpost", undef);
1472	return { 'message' => $msg };
1473	}
1474	} # /moderated comms
1475
1476	# posting:
1477
1478	$getlock->(); return $res if $res_done;
1479
1480	# do rate-checking
1481	if ($u->{'journaltype'} ne "Y" && ! LJ::rate_log($u, "post", 1)) {
1482	return $fail->($err,405);
1483	}
1484
1485	my $jitemid = LJ::alloc_user_counter($uowner, "L");
1486	return $fail->($err,501,"No itemid could be generated.") unless $jitemid;
1487
1488	# bring in LJ::Entry with Class::Autouse
1489	LJ::Entry->can("dostuff");
1490	LJ::replycount_do($uowner, $jitemid, "init");
1491
1492	# remove comments and logprops on new entry ... see comment by this sub for clarification
1493	LJ::Protocol::new_entry_cleanup_hack($u, $jitemid) if $LJ::NEW_ENTRY_CLEANUP_HACK;
1494	my $verb = $LJ::NEW_ENTRY_CLEANUP_HACK ? 'REPLACE' : 'INSERT';
1495
1496	my $dberr;
1497	$uowner->log2_do(\$dberr, "INSERT INTO log2 (journalid, jitemid, posterid, eventtime, logtime, security, ".
1498	"allowmask, replycount, year, month, day, revttime, rlogtime, anum) ".
1499	"VALUES ($ownerid, $jitemid, $posterid, $qeventtime, FROM_UNIXTIME($now), $qsecurity, $qallowmask, ".
1500	"0, $req->{'year'}, $req->{'mon'}, $req->{'day'}, $LJ::EndOfTime-".
1501	"UNIX_TIMESTAMP($qeventtime), $rlogtime, $anum)");
1502	return $fail->($err,501,$dberr) if $dberr;
1503
1504	LJ::MemCache::incr([$ownerid, "log2ct:$ownerid"]);
1505	LJ::memcache_kill($ownerid, "dayct2");
1506
1507	# set userprops.
1508	{
1509	my %set_userprop;
1510
1511	# keep track of itemid/anum for later potential duplicates
1512	$set_userprop{"dupsig_post"} = "$dupsig:$jitemid:$anum";
1513
1514	# record the eventtime of the last update (for own journals only)
1515	$set_userprop{"newesteventtime"} = $eventtime
1516	if $posterid == $ownerid and not $req->{'props'}->{'opt_backdated'} and not $time_was_faked;
1517
1518	LJ::set_userprop($u, \%set_userprop);
1519	}
1520
1521	# end duplicate locking section
1522	$release->();
1523
1524	my $ditemid = $jitemid * 256 + $anum;
1525
1526	### finish embedding stuff now that we have the itemid
1527	{
1528	### this should NOT return an error, and we're mildly fucked by now
1529	### if it does (would have to delete the log row up there), so we're
1530	### not going to check it for now.
1531
1532	my $error = "";
1533	foreach my $poll (@polls) {
1534	$poll->save_to_db(
1535	journalid => $ownerid,
1536	posterid => $posterid,
1537	ditemid => $ditemid,
1538	error => \$error,
1539	);
1540
1541	my $pollid = $poll->pollid;
1542
1543	$event =~ s/<lj-poll-placeholder>/<lj-poll-$pollid>/;
1544	}
1545	}
1546	#### /embedding
1547
1548	### extract links for meme tracking
1549	unless ($req->{'security'} eq "usemask" \|\|
1550	$req->{'security'} eq "private")
1551	{
1552	foreach my $url (LJ::get_urls($event)) {
1553	LJ::record_meme($url, $posterid, $ditemid, $ownerid);
1554	}
1555	}
1556
1557	# record journal's disk usage
1558	my $bytes = length($event) + length($req->{'subject'});
1559	$uowner->dudata_set('L', $jitemid, $bytes);
1560
1561	$uowner->do("$verb INTO logtext2 (journalid, jitemid, subject, event) ".
1562	"VALUES ($ownerid, $jitemid, ?, ?)", undef, $req->{'subject'},
1563	LJ::text_compress($event));
1564	if ($uowner->err) {
1565	my $msg = $uowner->errstr;
1566	LJ::delete_entry($uowner, $jitemid); # roll-back
1567	return fail($err,501,"logtext:$msg");
1568	}
1569	LJ::MemCache::set([$ownerid,"logtext:$clusterid:$ownerid:$jitemid"],
1570	[ $req->{'subject'}, $event ]);
1571
1572	# keep track of custom security stuff in other table.
1573	if ($uselogsec) {
1574	$uowner->do("INSERT INTO logsec2 (journalid, jitemid, allowmask) ".
1575	"VALUES ($ownerid, $jitemid, $qallowmask)");
1576	if ($uowner->err) {
1577	my $msg = $uowner->errstr;
1578	LJ::delete_entry($uowner, $jitemid); # roll-back
1579	return fail($err,501,"logsec2:$msg");
1580	}
1581	}
1582
1583	# Entry tags
1584	if ($req->{props} && defined $req->{props}->{taglist}) {
1585	# slightly misnamed, the taglist is/was normally a string, but now can also be an arrayref.
1586	my $taginput = $req->{props}->{taglist};
1587
1588	my $logtag_opts = {
1589	remote => $u,
1590	skipped_tags => [], # do all possible and report impossible
1591	};
1592
1593	if (ref $taginput eq 'ARRAY') {
1594	$logtag_opts->{set} = [@$taginput];
1595	$req->{props}->{taglist} = join(", ", @$taginput);
1596	} else {
1597	$logtag_opts->{set_string} = $taginput;
1598	}
1599
1600	my $rv = LJ::Tags::update_logtags($uowner, $jitemid, $logtag_opts);
1601	push @{$res->{warnings} \|\|= []}, LJ::Lang::ml('/update.bml.tags.skipped', { 'tags' => join(', ', @{$logtag_opts->{skipped_tags}}),
1602	'limit' => $uowner->get_cap('tags_max') } )
1603	if @{$logtag_opts->{skipped_tags}};
1604	}
1605
1606	## copyright
1607	if (LJ::is_enabled('default_copyright', $u)) {
1608	$req->{'props'}->{'copyright'} = $u->prop('default_copyright')
1609	unless defined $req->{'props'}->{'copyright'};
1610	$req->{'props'}->{'copyright'} = 'P' # second try
1611	unless defined $req->{'props'}->{'copyright'};
1612	} else {
1613	delete $req->{'props'}->{'copyright'};
1614	}
1615
1616	# meta-data
1617	if (%{$req->{'props'}}) {
1618	my $propset = {};
1619	foreach my $pname (keys %{$req->{'props'}}) {
1620	next unless $req->{'props'}->{$pname};
1621	next if $pname eq "revnum" \|\| $pname eq "revtime";
1622	my $p = LJ::get_prop("log", $pname);
1623	next unless $p;
1624	next unless $req->{'props'}->{$pname};
1625	$propset->{$pname} = $req->{'props'}->{$pname};
1626	}
1627	my %logprops;
1628	LJ::set_logprop($uowner, $jitemid, $propset, \%logprops) if %$propset;
1629
1630	# if set_logprop modified props above, we can set the memcache key
1631	# to be the hashref of modified props, since this is a new post
1632	LJ::MemCache::set([$uowner->{'userid'}, "logprop:$uowner->{'userid'}:$jitemid"],
1633	\%logprops) if %logprops;
1634	}
1635
1636	$dbh->do("UPDATE userusage SET timeupdate=NOW(), lastitemid=$jitemid ".
1637	"WHERE userid=$ownerid") unless $flags->{'notimeupdate'};
1638	LJ::MemCache::set([$ownerid, "tu:$ownerid"], pack("N", time()), 30*60);
1639
1640	# argh, this is all too ugly. need to unify more postpost stuff into async
1641	$u->invalidate_directory_record;
1642
1643	# note this post in recentactions table
1644	LJ::note_recent_action($uowner, 'post');
1645
1646	# if the post was public, and the user has not opted out, try to insert into the random table;
1647	# note we do INSERT INGORE since there will be lots of people posting every second, and that's
1648	# the granularity we use
1649	if ($security eq 'public' && LJ::u_equals($u, $uowner) && ! $u->prop('latest_optout')) {
1650	$u->do("INSERT IGNORE INTO random_user_set (posttime, userid) VALUES (UNIX_TIMESTAMP(), ?)",
1651	undef, $u->{userid});
1652	}
1653
1654	my @jobs; # jobs to add into TheSchwartz
1655
1656	# notify weblogs.com of post if necessary
1657	if (!$LJ::DISABLED{'weblogs_com'} && $u->{'opt_weblogscom'} && LJ::get_cap($u, "weblogscom") &&
1658	$security eq "public" && !$req->{'props'}->{'opt_backdated'}) {
1659	push @jobs, TheSchwartz::Job->new_from_array("LJ::Worker::Ping::WeblogsCom", {
1660	'user' => $u->{'user'},
1661	'title' => $u->{'journaltitle'} \|\| $u->{'name'},
1662	'url' => LJ::journal_base($u) . "/",
1663	});
1664	}
1665
1666	my $entry = LJ::Entry->new($uowner, jitemid => $jitemid, anum => $anum);
1667
1668	# run local site-specific actions
1669	LJ::run_hooks("postpost", {
1670	'itemid' => $jitemid,
1671	'anum' => $anum,
1672	'journal' => $uowner,
1673	'poster' => $u,
1674	'event' => $event,
1675	'eventtime' => $eventtime,
1676	'subject' => $req->{'subject'},
1677	'security' => $security,
1678	'allowmask' => $qallowmask,
1679	'props' => $req->{'props'},
1680	'entry' => $entry,
1681	'jobs' => \@jobs, # for hooks to push jobs onto
1682	'req' => $req,
1683	'res' => $res,
1684	});
1685
1686	# cluster tracking
1687	LJ::mark_user_active($u, 'post');
1688	LJ::mark_user_active($uowner, 'post') unless LJ::u_equals($u, $uowner);
1689
1690	$res->{'itemid'} = $jitemid; # by request of mart
1691	$res->{'anum'} = $anum;
1692	$res->{'url'} = $entry->url;
1693
1694	push @jobs, LJ::Event::JournalNewEntry->new($entry)->fire_job;
1695	push @jobs, LJ::Event::UserNewEntry->new($entry)->fire_job if (!$LJ::DISABLED{'esn-userevents'} \|\| $LJ::_T_FIRE_USERNEWENTRY);
1696	push @jobs, LJ::EventLogRecord::NewEntry->new($entry)->fire_job;
1697
1698	# PubSubHubbub Support
1699	LJ::Feed::generate_hubbub_jobs($uowner, \@jobs) unless $uowner->is_syndicated;
1700
1701	my $sclient = LJ::theschwartz();
1702	if ($sclient && @jobs) {
1703	my @handles = $sclient->insert_jobs(@jobs);
1704	# TODO: error on failure? depends on the job I suppose? property of the job?
1705	}
1706
1707	return $res;
1708	}
1709
1710	sub editevent
1711	{
1712	my ($req, $err, $flags) = @_;
1713	un_utf8_request($req);
1714
1715	return undef unless authenticate($req, $err, $flags);
1716
1717	my $spam = 0;
1718	return undef unless LJ::run_hook('spam_detector', $req, \$spam);
1719	return fail($err,320) if $spam;
1720
1721	# we check later that user owns entry they're modifying, so all
1722	# we care about for check_altusage is that the target journal
1723	# exists, and we want it to setup some data in $flags.
1724	$flags->{'ignorecanuse'} = 1;
1725	return undef unless check_altusage($req, $err, $flags);
1726
1727	my $u = $flags->{'u'};
1728	my $ownerid = $flags->{'ownerid'};
1729	my $uowner = $flags->{'u_owner'} \|\| $u;
1730	# Make sure we have a user object here
1731	$uowner = LJ::want_user($uowner) unless LJ::isu($uowner);
1732	my $clusterid = $uowner->{'clusterid'};
1733	my $posterid = $u->{'userid'};
1734	my $qallowmask = $req->{'allowmask'}+0;
1735	my $sth;
1736
1737	my $itemid = $req->{'itemid'}+0;
1738
1739	# underage users can't do this
1740	return fail($err,310) if $u->underage;
1741
1742	# check the journal's read-only bit
1743	return fail($err,306) if LJ::get_cap($uowner, "readonly");
1744
1745	# can't edit in deleted/suspended community
1746	return fail($err,307) unless $uowner->{'statusvis'} eq "V" \|\| $uowner->is_readonly;
1747
1748	my $dbcm = LJ::get_cluster_master($uowner);
1749	return fail($err,306) unless $dbcm;
1750
1751	# can't specify both a custom security and 'friends-only'
1752	return fail($err, 203, "Invalid friends group security set.")
1753	if $qallowmask > 1 && $qallowmask % 2;
1754
1755	### make sure user can't change a post to "custom/private security" on shared journals
1756	return fail($err,102)
1757	if ($ownerid != $posterid && # community post
1758	($req->{'security'} eq "private" \|\|
1759	($req->{'security'} eq "usemask" && $qallowmask != 1 )));
1760
1761	# make sure the new entry's under the char limit
1762	# NOTE: as in postevent, this requires $req->{event} to be binary data
1763	# but we've already removed the utf-8 flag in the XML-RPC path, and it
1764	# never gets set in the "flat" protocol path
1765	return fail($err,409) if length($req->{event}) >= LJ::BMAX_EVENT;
1766
1767	# fetch the old entry from master database so we know what we
1768	# really have to update later. usually people just edit one part,
1769	# not every field in every table. reads are quicker than writes,
1770	# so this is worth it.
1771	my $oldevent = $dbcm->selectrow_hashref
1772	("SELECT journalid AS 'ownerid', posterid, eventtime, logtime, ".
1773	"compressed, security, allowmask, year, month, day, ".
1774	"rlogtime, anum FROM log2 WHERE journalid=$ownerid AND jitemid=$itemid");
1775
1776	($oldevent->{subject}, $oldevent->{event}) = $dbcm->selectrow_array
1777	("SELECT subject, event FROM logtext2 ".
1778	"WHERE journalid=$ownerid AND jitemid=$itemid");
1779
1780	LJ::text_uncompress(\$oldevent->{'event'});
1781
1782	# use_old_content indicates the subject and entry are not changing
1783	if ($flags->{'use_old_content'}) {
1784	$req->{'event'} = $oldevent->{event};
1785	$req->{'subject'} = $oldevent->{subject};
1786	}
1787
1788	# kill seconds in eventtime, since we don't use it, then we can use 'eq' and such
1789	$oldevent->{'eventtime'} =~ s/:00$//;
1790
1791	### make sure this user is allowed to edit this entry
1792	return fail($err,302)
1793	unless ($ownerid == $oldevent->{'ownerid'});
1794
1795	### what can they do to somebody elses entry? (in shared journal)
1796	### can edit it if they own or maintain the journal, but not if the journal is read-only
1797	if ($posterid != $oldevent->{'posterid'} \|\| $u->is_readonly \|\| $uowner->is_readonly)
1798	{
1799	## deleting.
1800	return fail($err,304)
1801	if ($req->{'event'} !~ /\S/ && !
1802	($ownerid == $u->{'userid'} \|\|
1803	# community account can delete it (ick)
1804
1805	LJ::can_manage_other($posterid, $ownerid)
1806	# if user is a community maintainer they can delete
1807	# it too (good)
1808	));
1809
1810	## editing:
1811	if ($req->{'event'} =~ /\S/) {
1812	return fail($err,303) if $posterid != $oldevent->{'posterid'};
1813	return fail($err,318) if $u->is_readonly;
1814	return fail($err,319) if $uowner->is_readonly;
1815	}
1816	}
1817
1818	# simple logic for deleting an entry
1819	if (!$flags->{'use_old_content'} && $req->{'event'} !~ /\S/)
1820	{
1821
1822	## 23.11.2009. Next code added due to some hackers activities
1823	## that use trojans to delete user's entries in theirs journals.
1824	if ($LJ::DELETING_ENTRIES_IS_DISABLED
1825	&& $u->is_person and $u->userid eq $oldevent->{ownerid}
1826	){
1827	my $qsecurity = $uowner->quote('private');
1828	my $dberr;
1829	$uowner->log2_do(\$dberr, "UPDATE log2 SET security=$qsecurity " .
1830	"WHERE journalid=$ownerid AND jitemid=$itemid");
1831	return fail($err,501,$dberr) if $dberr;
1832	return fail($err, 321);
1833	}
1834
1835	# if their newesteventtime prop equals the time of the one they're deleting
1836	# then delete their newesteventtime.
1837	if ($u->{'userid'} == $uowner->{'userid'}) {
1838	LJ::load_user_props($u, { use_master => 1 }, "newesteventtime");
1839	if ($u->{'newesteventtime'} eq $oldevent->{'eventtime'}) {
1840	LJ::set_userprop($u, "newesteventtime", undef);
1841	}
1842	}
1843
1844	# log this event, unless noauth is on, which means it is being done internally and we should
1845	# rely on them to log why they're deleting the entry if they need to. that way we don't have
1846	# double entries, and we have as much information available as possible at the location the
1847	# delete is initiated.
1848	$uowner->log_event('delete_entry', {
1849	remote => $u,
1850	actiontarget => ($req->{itemid} * 256 + $oldevent->{anum}),
1851	method => 'protocol',
1852	})
1853	unless $flags->{noauth};
1854
1855	# We must use property 'dupsig_post' in author of entry to be deleted, not in
1856	# remote user or journal owner!
1857	my $item = LJ::get_log2_row($uowner, $req->{'itemid'});
1858	my $poster = $item ? LJ::want_user($item->{'posterid'}) : '';
1859
1860	LJ::delete_entry($uowner, $req->{'itemid'}, 'quick', $oldevent->{'anum'});
1861
1862	# clear their duplicate protection, so they can later repost
1863	# what they just deleted. (or something... probably rare.)
1864	LJ::set_userprop($poster, "dupsig_post", undef) if $poster;
1865
1866	my $res = { 'itemid' => $itemid,
1867	'anum' => $oldevent->{'anum'} };
1868	return $res;
1869	}
1870
1871	# now make sure the new entry text isn't $CannotBeShown
1872	return fail($err, 210)
1873	if $req->{event} eq $CannotBeShown;
1874
1875	# don't allow backdated posts in communities
1876	return fail($err,152) if
1877	($req->{'props'}->{"opt_backdated"} &&
1878	$uowner->{'journaltype'} ne "P");
1879
1880	# make year/mon/day/hour/min optional in an edit event,
1881	# and just inherit their old values
1882	{
1883	$oldevent->{'eventtime'} =~ /^(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d)/;
1884	$req->{'year'} = $1 unless defined $req->{'year'};
1885	$req->{'mon'} = $2+0 unless defined $req->{'mon'};
1886	$req->{'day'} = $3+0 unless defined $req->{'day'};
1887	$req->{'hour'} = $4+0 unless defined $req->{'hour'};
1888	$req->{'min'} = $5+0 unless defined $req->{'min'};
1889	}
1890
1891	# updating an entry:
1892	return undef
1893	unless common_event_validation($req, $err, $flags);
1894
1895	### load existing meta-data
1896	my %curprops;
1897	LJ::load_log_props2($dbcm, $ownerid, [ $itemid ], \%curprops);
1898
1899	## handle meta-data (properties)
1900	my %props_byname = ();
1901	foreach my $key (keys %{$req->{'props'}}) {
1902	## changing to something else?
1903	if ($curprops{$itemid}->{$key} ne $req->{'props'}->{$key}) {
1904	$props_byname{$key} = $req->{'props'}->{$key};
1905	}
1906	}
1907
1908	my $event = $req->{'event'};
1909	my $owneru = LJ::load_userid($ownerid);
1910	$event = LJ::EmbedModule->transform_rte_post($event);
1911	LJ::EmbedModule->parse_module_embed($owneru, \$event);
1912
1913	my $bytes = length($event) + length($req->{'subject'});
1914
1915	my $eventtime = sprintf("%04d-%02d-%02d %02d:%02d",
1916	map { $req->{$_} } qw(year mon day hour min));
1917	my $qeventtime = $dbcm->quote($eventtime);
1918
1919	# preserve old security by default, use user supplied if it's understood
1920	my $security = $oldevent->{security};
1921	$security = $req->{security}
1922	if $req->{security} &&
1923	$req->{security} =~ /^(?:public\|private\|usemask)$/;
1924
1925	my $do_tags = $req->{props} && defined $req->{props}->{taglist};
1926	if ($oldevent->{security} ne $security \|\| $qallowmask != $oldevent->{allowmask}) {
1927	# FIXME: this is a hopefully temporary hack which deletes tags from the entry
1928	# when the security has changed. the real fix is to make update_logtags aware
1929	# of security changes so it can update logkwsum appropriately.
1930
1931	unless ($do_tags) {
1932	# we need to fix security on this entry's tags, but the user didn't give us a tag list
1933	# to work with, so we have to go get the tags on the entry, and construct a tag list,
1934	# in order to pass to update_logtags down at the bottom of this whole update
1935	my $tags = LJ::Tags::get_logtags($uowner, $itemid);
1936	$tags = $tags->{$itemid};
1937	$req->{props}->{taglist} = join(',', sort values %{$tags \|\| {}});
1938	$do_tags = 1; # bleh, force the update later
1939	}
1940
1941	LJ::Tags::delete_logtags($uowner, $itemid);
1942	}
1943
1944	my $qyear = $req->{'year'}+0;
1945	my $qmonth = $req->{'mon'}+0;
1946	my $qday = $req->{'day'}+0;
1947
1948	if ($eventtime ne $oldevent->{'eventtime'} \|\|
1949	$security ne $oldevent->{'security'} \|\|
1950	(!$curprops{$itemid}->{opt_backdated} && $req->{props}{opt_backdated}) \|\|
1951	$qallowmask != $oldevent->{'allowmask'})
1952	{
1953	# are they changing their most recent post?
1954	LJ::load_user_props($u, "newesteventtime");
1955	if ($u->{userid} == $uowner->{userid} &&
1956	$u->{newesteventtime} eq $oldevent->{eventtime}) {
1957	# did they change the time?
1958	if ($eventtime ne $oldevent->{eventtime}) {
1959	# the newesteventtime is this event's new time.
1960	LJ::set_userprop($u, "newesteventtime", $eventtime);
1961	} elsif (!$curprops{$itemid}->{opt_backdated} && $req->{props}{opt_backdated}) {
1962	# otherwise, if they set the backdated flag,
1963	# then we no longer know the newesteventtime.
1964	LJ::set_userprop($u, "newesteventtime", undef);
1965	}
1966	}
1967
1968	my $qsecurity = $uowner->quote($security);
1969	my $dberr;
1970	$uowner->log2_do(\$dberr, "UPDATE log2 SET eventtime=$qeventtime, revttime=$LJ::EndOfTime-".
1971	"UNIX_TIMESTAMP($qeventtime), year=$qyear, month=$qmonth, day=$qday, ".
1972	"security=$qsecurity, allowmask=$qallowmask WHERE journalid=$ownerid ".
1973	"AND jitemid=$itemid");
1974	return fail($err,501,$dberr) if $dberr;
1975
1976	# update memcached
1977	my $sec = $qallowmask;
1978	$sec = 0 if $security eq 'private';
1979	$sec = 2**31 if $security eq 'public';
1980
1981	my $row = pack("NNNNN", $oldevent->{'posterid'},
1982	LJ::mysqldate_to_time($eventtime, 1),
1983	LJ::mysqldate_to_time($oldevent->{'logtime'}, 1),
1984	$sec,
1985	$itemid*256 + $oldevent->{'anum'});
1986
1987	LJ::MemCache::set([$ownerid, "log2:$ownerid:$itemid"], $row);
1988
1989	}
1990
1991	if ($security ne $oldevent->{'security'} \|\|
1992	$qallowmask != $oldevent->{'allowmask'})
1993	{
1994	if ($security eq "public" \|\| $security eq "private") {
1995	$uowner->do("DELETE FROM logsec2 WHERE journalid=$ownerid AND jitemid=$itemid");
1996	} else {
1997	$uowner->do("REPLACE INTO logsec2 (journalid, jitemid, allowmask) ".
1998	"VALUES ($ownerid, $itemid, $qallowmask)");
1999	}
2000	return fail($err,501,$dbcm->errstr) if $uowner->err;
2001	}
2002
2003	LJ::MemCache::set([$ownerid,"logtext:$clusterid:$ownerid:$itemid"],
2004	[ $req->{'subject'}, $event ]);
2005
2006	if (!$flags->{'use_old_content'} && (
2007	$event ne $oldevent->{'event'} \|\|
2008	$req->{'subject'} ne $oldevent->{'subject'}))
2009	{
2010	$uowner->do("UPDATE logtext2 SET subject=?, event=? ".
2011	"WHERE journalid=$ownerid AND jitemid=$itemid", undef,
2012	$req->{'subject'}, LJ::text_compress($event));
2013	return fail($err,501,$uowner->errstr) if $uowner->err;
2014
2015	# update disk usage
2016	$uowner->dudata_set('L', $itemid, $bytes);
2017	}
2018
2019	# up the revision number
2020	$req->{'props'}->{'revnum'} = ($curprops{$itemid}->{'revnum'} \|\| 0) + 1;
2021	$req->{'props'}->{'revtime'} = time();
2022
2023	my $res = { 'itemid' => $itemid };
2024
2025	# handle tags if they're defined
2026	if ($do_tags) {
2027	my $tagerr = "";
2028	my $skipped_tags = [];
2029	my $rv = LJ::Tags::update_logtags($uowner, $itemid, {
2030	set_string => $req->{props}->{taglist},
2031	remote => $u,
2032	err_ref => \$tagerr,
2033	skipped_tags => $skipped_tags, # do all possible and report impossible
2034	});
2035	push @{$res->{warnings} \|\|= []}, LJ::Lang::ml('/update.bml.tags.skipped', { 'tags' => join(', ', @$skipped_tags),
2036	'limit' => $uowner->get_cap('tags_max') } )
2037	if @$skipped_tags;
2038	}
2039
2040	if (LJ::is_enabled('default_copyright', $u)) {
2041	unless (defined $req->{'props'}->{'copyright'}) { # try 1: previous value
2042	$req->{'props'}->{'copyright'} = $curprops{$itemid}->{'copyright'};
2043	}
2044	unless (defined $req->{'props'}->{'copyright'}) { # try 2: global setting
2045	$req->{'props'}->{'copyright'} = $uowner->prop('default_copyright');
2046	}
2047	unless (defined $req->{'props'}->{'copyright'}) { # try 3: allow
2048	$req->{'props'}->{'copyright'} = 'P';
2049	}
2050	} else { # disabled feature
2051	delete $req->{'props'}->{'copyright'};
2052	}
2053
2054	# handle the props
2055	{
2056	my $propset = {};
2057	foreach my $pname (keys %{$req->{'props'}}) {
2058	my $p = LJ::get_prop("log", $pname);
2059	next unless $p;
2060	$propset->{$pname} = $req->{'props'}->{$pname};
2061	}
2062	LJ::set_logprop($uowner, $itemid, $propset);
2063
2064	if ($req->{'props'}->{'copyright'} ne $curprops{$itemid}->{'copyright'}) {
2065	LJ::Entry->new($ownerid, jitemid => $itemid)->put_logprop_in_history('copyright', $curprops{$itemid}->{'copyright'},
2066	$req->{'props'}->{'copyright'});
2067	}
2068	}
2069
2070	# deal with backdated changes. if the entry's rlogtime is
2071	# $EndOfTime, then it's backdated. if they want that off, need to
2072	# reset rlogtime to real reverse log time. also need to set
2073	# rlogtime to $EndOfTime if they're turning backdate on.
2074	if ($req->{'props'}->{'opt_backdated'} eq "1" &&
2075	$oldevent->{'rlogtime'} != $LJ::EndOfTime) {
2076	my $dberr;
2077	$uowner->log2_do(undef, "UPDATE log2 SET rlogtime=$LJ::EndOfTime WHERE ".
2078	"journalid=$ownerid AND jitemid=$itemid");
2079	return fail($err,501,$dberr) if $dberr;
2080	}
2081	if ($req->{'props'}->{'opt_backdated'} eq "0" &&
2082	$oldevent->{'rlogtime'} == $LJ::EndOfTime) {
2083	my $dberr;
2084	$uowner->log2_do(\$dberr, "UPDATE log2 SET rlogtime=$LJ::EndOfTime-UNIX_TIMESTAMP(logtime) ".
2085	"WHERE journalid=$ownerid AND jitemid=$itemid");
2086	return fail($err,501,$dberr) if $dberr;
2087	}
2088	return fail($err,501,$dbcm->errstr) if $dbcm->err;
2089
2090	LJ::memcache_kill($ownerid, "dayct2");
2091
2092	if (defined $oldevent->{'anum'}) {
2093	$res->{'anum'} = $oldevent->{'anum'};
2094	$res->{'url'} = LJ::item_link($uowner, $itemid, $oldevent->{'anum'});
2095	}
2096
2097	my $entry = LJ::Entry->new($ownerid, jitemid => $itemid);
2098	LJ::EventLogRecord::EditEntry->new($entry)->fire;
2099	my @jobs; # jobs to insert into TheSchwartz
2100	LJ::run_hooks("editpost", $entry, \@jobs);
2101
2102	# PubSubHubbub Support
2103	LJ::Feed::generate_hubbub_jobs($uowner, \@jobs) unless $uowner->is_syndicated;
2104
2105	my $sclient = LJ::theschwartz();
2106	if ($sclient && @jobs) {
2107	my @handles = $sclient->insert_jobs(@jobs);
2108	# TODO: error on failure? depends on the job I suppose? property of the job?
2109	}
2110
2111	return $res;
2112	}
2113
2114	sub getevents
2115	{
2116	my ($req, $err, $flags) = @_;
2117	return undef unless authenticate($req, $err, $flags);
2118
2119	$flags->{'ignorecanuse'} = 1; # later we will check security levels, so allow some access to communities
2120	return undef unless check_altusage($req, $err, $flags);
2121
2122	my $u = $flags->{'u'};
2123	my $uowner = $flags->{'u_owner'} \|\| $u;
2124
2125	### shared-journal support
2126	my $posterid = $u->{'userid'};
2127	my $ownerid = $flags->{'ownerid'};
2128
2129	my $dbr = LJ::get_db_reader();
2130	my $sth;
2131
2132	my $dbcr = LJ::get_cluster_reader($uowner);
2133	return fail($err,502) unless $dbcr && $dbr;
2134
2135	# can't pull events from deleted/suspended journal
2136	return fail($err,307) unless $uowner->{'statusvis'} eq "V" \|\| $uowner->is_readonly;
2137
2138	my $reject_code = $LJ::DISABLE_PROTOCOL{getevents};
2139	if (ref $reject_code eq "CODE") {
2140	my $errmsg = $reject_code->($req, $flags, eval { LJ::request->request });
2141	if ($errmsg) { return fail($err, "311", $errmsg); }
2142	}
2143
2144	# if this is on, we sort things different (logtime vs. posttime)
2145	# to avoid timezone issues
2146	my $is_community = ($uowner->{'journaltype'} eq "C" \|\|
2147	$uowner->{'journaltype'} eq "S");
2148
2149	# in some cases we'll use the master, to ensure there's no
2150	# replication delay. useful cases: getting one item, use master
2151	# since user might have just made a typo and realizes it as they
2152	# post, or wants to append something they forgot, etc, etc. in
2153	# other cases, slave is pretty sure to have it.
2154	my $use_master = 0;
2155
2156	# the benefit of this mode over actually doing 'lastn/1' is
2157	# the $use_master usage.
2158	if ($req->{'selecttype'} eq "one" && $req->{'itemid'} eq "-1") {
2159	$req->{'selecttype'} = "lastn";
2160	$req->{'howmany'} = 1;
2161	undef $req->{'itemid'};
2162	$use_master = 1; # see note above.
2163	}
2164
2165	# just synonym
2166	if ($req->{'itemshow'}){
2167	$req->{'selecttype'} = 'lastn' unless $req->{'selecttype'};
2168	$req->{'howmany'} = $req->{'itemshow'};
2169	}
2170	my $skip = $req->{'skip'} + 0;
2171	if ($skip > 500) { $skip = 500; }
2172
2173	# build the query to get log rows. each selecttype branch is
2174	# responsible for either populating the following 3 variables
2175	# OR just populating $sql
2176	my ($orderby, $where, $limit, $offset);
2177	my $sql;
2178	if ($req->{'selecttype'} eq "day")
2179	{
2180	return fail($err,203)
2181	unless ($req->{'year'} =~ /^\d\d\d\d$/ &&
2182	$req->{'month'} =~ /^\d\d?$/ &&
2183	$req->{'day'} =~ /^\d\d?$/ &&
2184	$req->{'month'} >= 1 && $req->{'month'} <= 12 &&
2185	$req->{'day'} >= 1 && $req->{'day'} <= 31);
2186
2187	my $qyear = $dbr->quote($req->{'year'});
2188	my $qmonth = $dbr->quote($req->{'month'});
2189	my $qday = $dbr->quote($req->{'day'});
2190	$where = "AND year=$qyear AND month=$qmonth AND day=$qday";
2191	$limit = "LIMIT 200"; # FIXME: unhardcode this constant (also in ljviews.pl)
2192
2193	# see note above about why the sort order is different
2194	$orderby = $is_community ? "ORDER BY logtime" : "ORDER BY eventtime";
2195	}
2196	elsif ($req->{'selecttype'} eq "lastn")
2197	{
2198	my $howmany = $req->{'howmany'} \|\| 20;
2199	if ($howmany > 50) { $howmany = 50; }
2200	$howmany = $howmany + 0;
2201	$limit = "LIMIT $howmany";
2202
2203	$offset = "OFFSET $skip";
2204
2205	# okay, follow me here... see how we add the revttime predicate
2206	# even if no beforedate key is present? you're probably saying,
2207	# that's retarded -- you're saying: "revttime > 0", that's like
2208	# saying, "if entry occurred at all." yes yes, but that hints
2209	# mysql's braindead optimizer to use the right index.
2210	my $rtime_after = 0;
2211	my $rtime_what = $is_community ? "rlogtime" : "revttime";
2212	if ($req->{'beforedate'}) {
2213	return fail($err,203,"Invalid beforedate format.")
2214	unless ($req->{'beforedate'} =~
2215	/^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d$/);
2216	my $qd = $dbr->quote($req->{'beforedate'});
2217	$rtime_after = "$LJ::EndOfTime-UNIX_TIMESTAMP($qd)";
2218	}
2219	$where .= "AND $rtime_what > $rtime_after ";
2220	$orderby = "ORDER BY $rtime_what";
2221	}
2222	elsif ($req->{'selecttype'} eq "one")
2223	{
2224	my $id = $req->{'itemid'} + 0;
2225	$where = "AND jitemid=$id";
2226	}
2227	elsif ($req->{'selecttype'} eq "syncitems")
2228	{
2229	return fail($err,506) if $LJ::DISABLED{'syncitems'};
2230	my $date = $req->{'lastsync'} \|\| "0000-00-00 00:00:00";
2231	return fail($err,203,"Invalid syncitems date format")
2232	unless ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
2233
2234	my $now = time();
2235	# broken client loop prevention
2236	if ($req->{'lastsync'}) {
2237	my $pname = "rl_syncitems_getevents_loop";
2238	LJ::load_user_props($u, $pname);
2239	# format is: time/date/time/date/time/date/... so split
2240	# it into a hash, then delete pairs that are older than an hour
2241	my %reqs = split(m!/!, $u->{$pname});
2242	foreach (grep { $_ < $now - 60*60 } keys %reqs) { delete $reqs{$_}; }
2243	my $count = grep { $_ eq $date } values %reqs;
2244	$reqs{$now} = $date;
2245	if ($count >= 2) {
2246	# 2 prior, plus this one = 3 repeated requests for same synctime.
2247	# their client is busted. (doesn't understand syncitems semantics)
2248	return fail($err,406);
2249	}
2250	LJ::set_userprop($u, $pname,
2251	join('/', map { $_, $reqs{$_} }
2252	sort { $b <=> $a } keys %reqs));
2253	}
2254
2255	my %item;
2256	$sth = $dbcr->prepare("SELECT jitemid, logtime FROM log2 WHERE ".
2257	"journalid=? and logtime > ?");
2258	$sth->execute($ownerid, $date);
2259	while (my ($id, $dt) = $sth->fetchrow_array) {
2260	$item{$id} = $dt;
2261	}
2262
2263	my $p_revtime = LJ::get_prop("log", "revtime");
2264	$sth = $dbcr->prepare("SELECT jitemid, FROM_UNIXTIME(value) ".
2265	"FROM logprop2 WHERE journalid=? ".
2266	"AND propid=$p_revtime->{'id'} ".
2267	"AND value+0 > UNIX_TIMESTAMP(?)");
2268	$sth->execute($ownerid, $date);
2269	while (my ($id, $dt) = $sth->fetchrow_array) {
2270	$item{$id} = $dt;
2271	}
2272
2273	my $limit = 100;
2274	my @ids = sort { $item{$a} cmp $item{$b} } keys %item;
2275	if (@ids > $limit) { @ids = @ids[0..$limit-1]; }
2276
2277	my $in = join(',', @ids) \|\| "0";
2278	$where = "AND jitemid IN ($in)";
2279	}
2280	elsif ($req->{'selecttype'} eq "multiple")
2281	{
2282	my @ids;
2283	foreach my $num (split(/\s,\s/, $req->{'itemids'})) {
2284	return fail($err,203,"Non-numeric itemid") unless $num =~ /^\d+$/;
2285	push @ids, $num;
2286	}
2287	my $limit = 100;
2288	return fail($err,209,"Can't retrieve more than $limit entries at once") if @ids > $limit;
2289	my $in = join(',', @ids);
2290	$where = "AND jitemid IN ($in)";
2291	}
2292	elsif ($req->{'selecttype'} eq 'before')
2293	{
2294	my $before = $req->{'before'};
2295	my $itemshow = $req->{'howmany'};
2296	my $itemselect = $itemshow + $skip;
2297
2298	my %item;
2299	$sth = $dbcr->prepare("SELECT jitemid, logtime FROM log2 WHERE ".
2300	"journalid=? and logtime < ? LIMIT $itemselect");
2301	$sth->execute($ownerid, $before);
2302	while (my ($id, $dt) = $sth->fetchrow_array) {
2303	$item{$id} = $dt;
2304
2305	}
2306
2307	my $p_revtime = LJ::get_prop("log", "revtime");
2308
2309	$sth = $dbcr->prepare("SELECT jitemid, FROM_UNIXTIME(value) ".
2310	"FROM logprop2 WHERE journalid=? ".
2311	"AND propid=$p_revtime->{'id'} ".
2312	"AND value+0 < ? LIMIT $itemselect");
2313	$sth->execute($ownerid, $before);
2314	while (my ($id, $dt) = $sth->fetchrow_array) {
2315	$item{$id} = $dt;
2316	}
2317
2318	my @ids = sort { $item{$a} cmp $item{$b} } keys %item;
2319	if (@ids > $skip){
2320	@ids = @ids[$skip..(@ids-1)];
2321	@ids = @ids[0..$itemshow-1] if @ids > $itemshow;
2322	}else{
2323	@ids = ();
2324	}
2325
2326	my $in = join(',', @ids) \|\| "0";
2327	$where = "AND jitemid IN ($in)";
2328	}
2329	else
2330	{
2331	return fail($err,200,"Invalid selecttype.");
2332	}
2333
2334	my $secmask = 0;
2335	if ($u && ($u->{'journaltype'} eq "P" \|\| $u->{'journaltype'} eq "I") && $posterid != $ownerid) {
2336	$secmask = LJ::get_groupmask($ownerid, $posterid);
2337	}
2338
2339	# decide what level of security the remote user can see
2340	# 'getevents' used in small count of places and we will not pass 'viewall' through their call chain
2341	my $secwhere = "";
2342	if ($posterid == $ownerid) {
2343	# no extra where restrictions... user can see all their own stuff
2344	} elsif ($secmask) {
2345	# can see public or things with them in the mask
2346	$secwhere = "AND (security='public' OR (security='usemask' AND allowmask & $secmask != 0) OR posterid=$posterid)";
2347	} else {
2348	# not a friend? only see public.
2349	$secwhere = "AND (security='public' OR posterid=$posterid)";
2350	}
2351
2352	# common SQL template:
2353	unless ($sql) {
2354	$sql = "SELECT jitemid, eventtime, security, allowmask, anum, posterid, replycount, UNIX_TIMESTAMP(eventtime) ".
2355	"FROM log2 WHERE journalid=$ownerid $secwhere $where $orderby $limit $offset";
2356	}
2357
2358	# whatever selecttype might have wanted us to use the master db.
2359	$dbcr = LJ::get_cluster_def_reader($uowner) if $use_master;
2360
2361	return fail($err,502) unless $dbcr;
2362
2363	## load the log rows
2364	($sth = $dbcr->prepare($sql))->execute;
2365	return fail($err,501,$dbcr->errstr) if $dbcr->err;
2366
2367	my $count = 0;
2368	my @itemids = ();
2369	my $res = { skip => $skip };
2370	my $events = $res->{'events'} = [];
2371	my %evt_from_itemid;
2372
2373	while (my ($itemid, $eventtime, $sec, $mask, $anum, $jposterid, $replycount, $event_timestamp) = $sth->fetchrow_array)
2374	{
2375	$count++;
2376	my $evt = {};
2377	$evt->{'itemid'} = $itemid;
2378	push @itemids, $itemid;
2379
2380	$evt_from_itemid{$itemid} = $evt;
2381
2382	$evt->{"eventtime"} = $eventtime;
2383	$evt->{event_timestamp} = $event_timestamp;
2384	if ($sec ne "public") {
2385	$evt->{'security'} = $sec;
2386	$evt->{'allowmask'} = $mask if $sec eq "usemask";
2387	}
2388	$evt->{'anum'} = $anum;
2389	$evt->{'poster'} = LJ::get_username($dbr, $jposterid) if $jposterid != $ownerid;
2390	$evt->{'url'} = LJ::item_link($uowner, $itemid, $anum);
2391	$evt->{'reply_count'} = $replycount;
2392	push @$events, $evt;
2393	}
2394
2395	# load properties. Even if the caller doesn't want them, we need
2396	# them in Unicode installations to recognize older 8bit non-UF-8
2397	# entries.
2398	unless ($req->{'noprops'} && !$LJ::UNICODE)
2399	{
2400	### do the properties now
2401	$count = 0;
2402	my %props = ();
2403	LJ::load_log_props2($dbcr, $ownerid, \@itemids, \%props);
2404
2405	# load the tags for these entries, unless told not to
2406	unless ($req->{notags}) {
2407	# construct %idsbycluster for the multi call to get these tags
2408	my $tags = LJ::Tags::get_logtags($uowner, \@itemids);
2409
2410	# add to props
2411	foreach my $itemid (@itemids) {
2412	next unless $tags->{$itemid};
2413	$props{$itemid}->{taglist} = join(', ', values %{$tags->{$itemid}});
2414	}
2415	}
2416
2417	foreach my $itemid (keys %props) {
2418	# 'replycount' is a pseudo-prop, don't send it.
2419	# FIXME: this goes away after we restructure APIs and
2420	# replycounts cease being transferred in props
2421	delete $props{$itemid}->{'replycount'};
2422
2423	my $evt = $evt_from_itemid{$itemid};
2424	$evt->{'props'} = {};
2425	foreach my $name (keys %{$props{$itemid}}) {
2426	my $value = $props{$itemid}->{$name};
2427	$value =~ s/\n/ /g;
2428	$evt->{'props'}->{$name} = $value;
2429	}
2430	}
2431	}
2432
2433	## load the text
2434	my $text = LJ::cond_no_cache($use_master, sub {
2435	return LJ::get_logtext2($uowner, @itemids);
2436	});
2437
2438	foreach my $i (@itemids)
2439	{
2440	my $t = $text->{$i};
2441	my $evt = $evt_from_itemid{$i};
2442
2443	# if they want subjects to be events, replace event
2444	# with subject when requested.
2445	if ($req->{'prefersubject'} && length($t->[0])) {
2446	$t->[1] = $t->[0]; # event = subject
2447	$t->[0] = undef; # subject = undef
2448	}
2449
2450	# now that we have the subject, the event and the props,
2451	# auto-translate them to UTF-8 if they're not in UTF-8.
2452	if ($LJ::UNICODE && $req->{'ver'} >= 1 &&
2453	$evt->{'props'}->{'unknown8bit'}) {
2454	my $error = 0;
2455	$t->[0] = LJ::text_convert($t->[0], $uowner, \$error);
2456	$t->[1] = LJ::text_convert($t->[1], $uowner, \$error);
2457	foreach (keys %{$evt->{'props'}}) {
2458	$evt->{'props'}->{$_} = LJ::text_convert($evt->{'props'}->{$_}, $uowner, \$error);
2459	}
2460	return fail($err,208,"Cannot display this post. Please see $LJ::SITEROOT/support/encodings.bml for more information.")
2461	if $error;
2462	}
2463
2464	if ($LJ::UNICODE && $req->{'ver'} < 1 && !$evt->{'props'}->{'unknown8bit'}) {
2465	unless ( LJ::is_ascii($t->[0]) &&
2466	LJ::is_ascii($t->[1]) &&
2467	LJ::is_ascii(join(' ', values %{$evt->{'props'}}) )) {
2468	# we want to fail the client that wants to get this entry
2469	# but we make an exception for selecttype=day, in order to allow at least
2470	# viewing the daily summary
2471
2472	if ($req->{'selecttype'} eq 'day') {
2473	$t->[0] = $t->[1] = $CannotBeShown;
2474	} else {
2475	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.");
2476	}
2477	}
2478	}
2479
2480	if ($t->[0]) {
2481	$t->[0] =~ s/[\r\n]/ /g;
2482	$evt->{'subject'} = $t->[0];
2483	}
2484
2485	$t->[1] = LJ::trim_widgets(
2486	length => $req->{trim_widgets},
2487	img_length => $req->{widgets_img_length},
2488	text => $t->[1],
2489	read_more => '<a href="' . $evt->{url} . '"> ...</a>',
2490	) if $req->{trim_widgets};
2491
2492	$t->[1] = LJ::convert_lj_tags_to_links(
2493	event => $t->[1],
2494	embed_url => $evt->{url},
2495	) if $req->{parseljtags};
2496
2497
2498	# truncate
2499	if ($req->{'truncate'} >= 4) {
2500	my $original = $t->[1];
2501	if ($req->{'ver'} > 1) {
2502	$t->[1] = LJ::text_trim($t->[1], $req->{'truncate'} - 3, 0);
2503	} else {
2504	$t->[1] = LJ::text_trim($t->[1], 0, $req->{'truncate'} - 3);
2505	}
2506	# only append the elipsis if the text was actually truncated
2507	$t->[1] .= "..." if $t->[1] ne $original;
2508	}
2509
2510	# line endings
2511	$t->[1] =~ s/\r//g;
2512	if ($req->{'lineendings'} eq "unix") {
2513	# do nothing. native format.
2514	} elsif ($req->{'lineendings'} eq "mac") {
2515	$t->[1] =~ s/\n/\r/g;
2516	} elsif ($req->{'lineendings'} eq "space") {
2517	$t->[1] =~ s/\n/ /g;
2518	} elsif ($req->{'lineendings'} eq "dots") {
2519	$t->[1] =~ s/\n/ ... /g;
2520	} else { # "pc" -- default
2521	$t->[1] =~ s/\n/\r\n/g;
2522	}
2523	$evt->{'event'} = $t->[1];
2524	}
2525
2526	# maybe we don't need the props after all
2527	if ($req->{'noprops'}) {
2528	foreach(@$events) { delete $_->{'props'}; }
2529	}
2530
2531	return $res;
2532	}
2533
2534	sub editfriends
2535	{
2536	my ($req, $err, $flags) = @_;
2537	return undef unless authenticate($req, $err, $flags);
2538
2539	my $u = $flags->{'u'};
2540	my $userid = $u->{'userid'};
2541	my $dbh = LJ::get_db_writer();
2542	my $sth;
2543
2544	return fail($err,306) unless $dbh;
2545
2546	# do not let locked people do this
2547	return fail($err, 308) if $u->{statusvis} eq 'L';
2548
2549	#
2550	# Do not have values for $LJ::ADD_FRIEND_RATE_LIMIT
2551	#
2552	# # check action frequency
2553	# unless ($flags->{no_rate_check}){
2554	# my $cond = ["ratecheck:add_friend:$userid",
2555	# [ $LJ::ADD_FRIEND_RATE_LIMIT \|\| [ 10, 600 ] ]
2556	# ];
2557	# return fail($err, 411)
2558	# unless LJ::RateLimit->check($u, [ $cond ]);
2559	# }
2560
2561	my $res = {};
2562
2563	## first, figure out who the current friends are to save us work later
2564	my %curfriend;
2565	my $friend_count = 0;
2566	my $friends_changed = 0;
2567
2568	# TAG:FR:protocol:editfriends1
2569	$sth = $dbh->prepare("SELECT u.user FROM useridmap u, friends f ".
2570	"WHERE u.userid=f.friendid AND f.userid=$userid");
2571	$sth->execute;
2572	while (my ($friend) = $sth->fetchrow_array) {
2573	$curfriend{$friend} = 1;
2574	$friend_count++;
2575	}
2576	$sth->finish;
2577
2578	# perform the deletions
2579	DELETEFRIEND:
2580	foreach (@{$req->{'delete'}})
2581	{
2582	my $deluser = LJ::canonical_username($_);
2583	next DELETEFRIEND unless ($curfriend{$deluser});
2584
2585	my $friendid = LJ::get_userid($deluser);
2586	# TAG:FR:protocol:editfriends2_del
2587	LJ::remove_friend($userid, $friendid);
2588	$friend_count--;
2589	$friends_changed = 1;
2590	}
2591
2592	my $error_flag = 0;
2593	my $friends_added = 0;
2594	my $fail = sub {
2595	LJ::memcache_kill($userid, "friends");
2596	LJ::mark_dirty($userid, "friends");
2597	return fail($err, $_[0], $_[1]);
2598	};
2599
2600	# only people, shared journals, and owned syn feeds can add friends
2601	return $fail->(104, "Journal type cannot add friends")
2602	unless ($u->{'journaltype'} eq 'P' \|\|
2603	$u->{'journaltype'} eq 'S' \|\|
2604	$u->{'journaltype'} eq 'I' \|\|
2605	($u->{'journaltype'} eq "Y" && $u->password));
2606
2607	# Don't let suspended users add friend
2608	return $fail->(305, "Suspended journals cannot add friends.")
2609	if ($u->is_suspended);
2610
2611	my $sclient = LJ::theschwartz();
2612
2613	# perform the adds
2614	ADDFRIEND:
2615	foreach my $fa (@{$req->{'add'}})
2616	{
2617	unless (ref $fa eq "HASH") {
2618	$fa = { 'username' => $fa };
2619	}
2620
2621	my $aname = LJ::canonical_username($fa->{'username'});
2622	unless ($aname) {
2623	$error_flag = 1;
2624	next ADDFRIEND;
2625	}
2626
2627	$friend_count++ unless $curfriend{$aname};
2628
2629	my $err;
2630	return $fail->(104, "$err")
2631	unless $u->can_add_friends(\$err, { 'numfriends' => $friend_count, friend => $fa });
2632
2633	my $fg = $fa->{'fgcolor'} \|\| "#000000";
2634	my $bg = $fa->{'bgcolor'} \|\| "#FFFFFF";
2635	if ($fg !~ /^\#[0-9A-F]{6,6}$/i \|\| $bg !~ /^\#[0-9A-F]{6,6}$/i) {
2636	return $fail->(203, "Invalid color values");
2637	}
2638
2639	my $row = LJ::load_user($aname);
2640	my $currently_is_friend = LJ::is_friend($u, $row);
2641	my $currently_is_banned = LJ::is_banned($u, $row);
2642
2643	# XXX - on some errors we fail out, on others we continue and try adding
2644	# any other users in the request. also, error message for redirect should
2645	# point the user to the redirected username.
2646	if (! $row) {
2647	$error_flag = 1;
2648	} elsif ($row->{'journaltype'} eq "R") {
2649	return $fail->(154);
2650	} elsif ($row->{'statusvis'} ne "V") {
2651	$error_flag = 1;
2652	} else {
2653	$friends_added++;
2654	my $added = { 'username' => $aname,
2655	'fullname' => $row->{'name'},
2656	'journaltype' => $row->{journaltype},
2657	'defaultpicurl' => ($row->{'defaultpicid'} && "$LJ::USERPIC_ROOT/$row->{'defaultpicid'}/$row->{'userid'}"),
2658	};
2659	if ($req->{'ver'} >= 1) {
2660	LJ::text_out(\$added->{'fullname'});
2661	}
2662	push @{$res->{'added'}}, $added;
2663
2664	my $qfg = LJ::color_todb($fg);
2665	my $qbg = LJ::color_todb($bg);
2666
2667	my $friendid = $row->{'userid'};
2668
2669	my $gmask = $fa->{'groupmask'};
2670	if (! $gmask && $curfriend{$aname}) {
2671	# if no group mask sent, use the existing one if this is an existing friend
2672	# TAG:FR:protocol:editfriends3_getmask
2673	my $sth = $dbh->prepare("SELECT groupmask FROM friends ".
2674	"WHERE userid=$userid AND friendid=$friendid");
2675	$sth->execute;
2676	$gmask = $sth->fetchrow_array;
2677	}
2678	# force bit 0 on.
2679	$gmask \|= 1;
2680
2681	# TAG:FR:protocol:editfriends4_addeditfriend
2682	my $cnt = $dbh->do("REPLACE INTO friends (userid, friendid, fgcolor, bgcolor, groupmask) ".
2683	"VALUES ($userid, $friendid, $qfg, $qbg, $gmask)");
2684	return $fail->(501,$dbh->errstr) if $dbh->err;
2685
2686	if ($cnt == 1) {
2687	LJ::run_hooks('befriended', LJ::load_userid($userid), LJ::load_userid($friendid));
2688	}
2689
2690	my $memkey = [$userid,"frgmask:$userid:$friendid"];
2691	LJ::MemCache::set($memkey, $gmask+0, time()+60*15);
2692	LJ::memcache_kill($friendid, 'friendofs');
2693	LJ::memcache_kill($friendid, 'friendofs2');
2694
2695	if ($sclient && !$currently_is_friend && !$currently_is_banned) {
2696	my @jobs;
2697	push @jobs, LJ::Event::Befriended->new(LJ::load_userid($friendid), LJ::load_userid($userid))->fire_job
2698	if !$LJ::DISABLED{esn};
2699
2700	push @jobs, TheSchwartz::Job->new(
2701	funcname => "LJ::Worker::FriendChange",
2702	arg => [$userid, 'add', $friendid],
2703	) unless $LJ::DISABLED{'friendchange-schwartz'};
2704
2705	$sclient->insert_jobs(@jobs) if @jobs;
2706	}
2707	$friends_changed = 1;
2708	}
2709	}
2710
2711	return $fail->(104) if $error_flag;
2712
2713	# invalidate memcache of friends
2714	LJ::memcache_kill($userid, "friends");
2715	LJ::memcache_kill($userid, "friends2");
2716	LJ::mark_dirty($userid, "friends");
2717
2718	LJ::run_hooks('friends_changed', LJ::load_userid($userid)) if $friends_changed;
2719
2720	return $res;
2721	}
2722
2723	sub editfriendgroups
2724	{
2725	my ($req, $err, $flags) = @_;
2726	return undef unless authenticate($req, $err, $flags);
2727
2728	my $u = $flags->{'u'};
2729	my $userid = $u->{'userid'};
2730	my ($db, $fgtable, $bmax, $cmax) = $u->{dversion} > 5 ?
2731	($u->writer, 'friendgroup2', LJ::BMAX_GRPNAME2, LJ::CMAX_GRPNAME2) :
2732	(LJ::get_db_writer(), 'friendgroup', LJ::BMAX_GRPNAME, LJ::CMAX_GRPNAME);
2733	my $sth;
2734
2735	return fail($err,306) unless $db;
2736
2737	# do not let locked people do this
2738	return fail($err, 308) if $u->{statusvis} eq 'L';
2739
2740	my $res = {};
2741
2742	## make sure tree is how we want it
2743	$req->{'groupmasks'} = {} unless
2744	(ref $req->{'groupmasks'} eq "HASH");
2745	$req->{'set'} = {} unless
2746	(ref $req->{'set'} eq "HASH");
2747	$req->{'delete'} = [] unless
2748	(ref $req->{'delete'} eq "ARRAY");
2749
2750	# Keep track of what bits are already set, so we can know later
2751	# whether to INSERT or UPDATE.
2752	my %bitset;
2753	my $groups = LJ::get_friend_group($userid);
2754	foreach my $bit (keys %{$groups \|\| {}}) {
2755	$bitset{$bit} = 1;
2756	}
2757
2758	## before we perform any DB operations, validate input text
2759	# (groups' names) for correctness so we can fail gracefully
2760	if ($LJ::UNICODE) {
2761	foreach my $bit (keys %{$req->{'set'}})
2762	{
2763	my $name = $req->{'set'}->{$bit}->{'name'};
2764	return fail($err,207,"non-ASCII names require a Unicode-capable client")
2765	if $req->{'ver'} < 1 and not LJ::is_ascii($name);
2766	return fail($err,208,"Invalid group names. Please see $LJ::SITEROOT/support/encodings.bml for more information.")
2767	unless LJ::text_in($name);
2768	}
2769	}
2770
2771	## figure out deletions we'll do later
2772	foreach my $bit (@{$req->{'delete'}})
2773	{
2774	$bit += 0;
2775	next unless ($bit >= 1 && $bit <= 30);
2776	$bitset{$bit} = 0; # so later we replace into, not update.
2777	}
2778
2779	## do additions/modifications ('set' hash)
2780	my %added;
2781	foreach my $bit (keys %{$req->{'set'}})
2782	{
2783	$bit += 0;
2784	next unless ($bit >= 1 && $bit <= 30);
2785	my $sa = $req->{'set'}->{$bit};
2786	my $name = LJ::text_trim($sa->{'name'}, $bmax, $cmax);
2787
2788	# can't end with a slash
2789	$name =~ s!/$!!;
2790
2791	# setting it to name is like deleting it.
2792	unless ($name =~ /\S/) {
2793	push @{$req->{'delete'}}, $bit;
2794	next;
2795	}
2796
2797	my $qname = $db->quote($name);
2798	my $qsort = defined $sa->{'sort'} ? ($sa->{'sort'}+0) : 50;
2799	my $qpublic = $db->quote(defined $sa->{'public'} ? ($sa->{'public'}+0) : 0);
2800
2801	if ($bitset{$bit}) {
2802	# so update it
2803	my $sets;
2804	if (defined $sa->{'public'}) {
2805	$sets .= ", is_public=$qpublic";
2806	}
2807	$db->do("UPDATE $fgtable SET groupname=$qname, sortorder=$qsort ".
2808	"$sets WHERE userid=$userid AND groupnum=$bit");
2809	} else {
2810	$db->do("REPLACE INTO $fgtable (userid, groupnum, ".
2811	"groupname, sortorder, is_public) VALUES ".
2812	"($userid, $bit, $qname, $qsort, $qpublic)");
2813	}
2814	$added{$bit} = 1;
2815	}
2816
2817
2818	## do deletions ('delete' array)
2819	my $dbcm = LJ::get_cluster_master($u);
2820
2821	# ignore bits that aren't integers or that are outside 1-30 range
2822	my @delete_bits = grep {$_ >= 1 and $_ <= 30} map {$_+0} @{$req->{'delete'}};
2823	my $delete_mask = 0;
2824	foreach my $bit (@delete_bits) {
2825	$delete_mask \|= (1 << $bit)
2826	}
2827
2828	# remove the bits for deleted groups from all friends groupmasks
2829	my $dbh = LJ::get_db_writer();
2830	if ($delete_mask) {
2831	# TAG:FR:protocol:editfriendgroups_removemasks
2832	$dbh->do("UPDATE friends".
2833	" SET groupmask = groupmask & ~$delete_mask".
2834	" WHERE userid = $userid");
2835	}
2836
2837	foreach my $bit (@delete_bits)
2838	{
2839	# remove all posts from allowing that group:
2840	my @posts_to_clean = ();
2841	$sth = $dbcm->prepare("SELECT jitemid FROM logsec2 WHERE journalid=$userid AND allowmask & (1 << $bit)");
2842	$sth->execute;
2843	while (my ($id) = $sth->fetchrow_array) { push @posts_to_clean, $id; }
2844	while (@posts_to_clean) {
2845	my @batch;
2846	if (scalar(@posts_to_clean) < 20) {
2847	@batch = @posts_to_clean;
2848	@posts_to_clean = ();
2849	} else {
2850	@batch = splice(@posts_to_clean, 0, 20);
2851	}
2852
2853	my $in = join(",", @batch);
2854	$u->do("UPDATE log2 SET allowmask=allowmask & ~(1 << $bit) ".
2855	"WHERE journalid=$userid AND jitemid IN ($in) AND security='usemask'");
2856	$u->do("UPDATE logsec2 SET allowmask=allowmask & ~(1 << $bit) ".
2857	"WHERE journalid=$userid AND jitemid IN ($in)");
2858
2859	foreach my $id (@batch) {
2860	LJ::MemCache::delete([$userid, "log2:$userid:$id"]);
2861	}
2862	LJ::MemCache::delete([$userid, "log2lt:$userid"]);
2863	}
2864	LJ::Tags::deleted_friend_group($u, $bit);
2865	LJ::run_hooks('delete_friend_group', $u, $bit);
2866
2867	# remove the friend group, unless we just added it this transaction
2868	unless ($added{$bit}) {
2869	$db->do("DELETE FROM $fgtable WHERE ".
2870	"userid=$userid AND groupnum=$bit");
2871	}
2872	}
2873
2874	## change friends' masks
2875	# TAG:FR:protocol:editfriendgroups_changemasks
2876	foreach my $friend (keys %{$req->{'groupmasks'}})
2877	{
2878	my $mask = int($req->{'groupmasks'}->{$friend}) \| 1;
2879	my $friendid = LJ::get_userid($dbh, $friend);
2880
2881	$dbh->do("UPDATE friends SET groupmask=$mask ".
2882	"WHERE userid=$userid AND friendid=?",
2883	undef, $friendid);
2884	LJ::MemCache::set([$userid, "frgmask:$userid:$friendid"], $mask);
2885	}
2886
2887	# invalidate memcache of friends/groups
2888	LJ::memcache_kill($userid, "friends");
2889	LJ::memcache_kill($userid, "fgrp");
2890	LJ::mark_dirty($u, "friends");
2891
2892	# return value for this is nothing.
2893	return {};
2894	}
2895
2896	sub sessionexpire {
2897	my ($req, $err, $flags) = @_;
2898	return undef unless authenticate($req, $err, $flags);
2899	my $u = $flags->{u};
2900
2901	# expunge one? or all?
2902	if ($req->{expireall}) {
2903	$u->kill_all_sessions;
2904	return {};
2905	}
2906
2907	# just expire a list
2908	my $list = $req->{expire} \|\| [];
2909	return {} unless @$list;
2910	return fail($err,502) unless $u->writer;
2911	$u->kill_sessions(@$list);
2912	return {};
2913	}
2914
2915	sub sessiongenerate {
2916	# generate a session
2917	my ($req, $err, $flags) = @_;
2918	return undef unless authenticate($req, $err, $flags);
2919
2920	# sanitize input
2921	$req->{expiration} = 'short' unless $req->{expiration} eq 'long';
2922	my $boundip;
2923	$boundip = LJ::get_remote_ip() if $req->{bindtoip};
2924
2925	my $u = $flags->{u};
2926	my $sess_opts = {
2927	exptype => $req->{expiration},
2928	ipfixed => $boundip,
2929	};
2930
2931	# do not let locked people do this
2932	return fail($err, 308) if $u->{statusvis} eq 'L';
2933
2934	my $sess = LJ::Session->create($u, %$sess_opts);
2935
2936	# return our hash
2937	return {
2938	ljsession => $sess->master_cookie_string,
2939	};
2940	}
2941
2942	sub list_friends
2943	{
2944	my ($u, $opts) = @_;
2945
2946	# do not show people in here
2947	my %hide; # userid -> 1
2948
2949	# TAG:FR:protocol:list_friends
2950	my $sql;
2951	unless ($opts->{'friendof'}) {
2952	$sql = "SELECT friendid, fgcolor, bgcolor, groupmask FROM friends WHERE userid=?";
2953	} else {
2954	$sql = "SELECT userid FROM friends WHERE friendid=?";
2955
2956	if (my $list = LJ::load_rel_user($u, 'B')) {
2957	$hide{$_} = 1 foreach @$list;
2958	}
2959	}
2960
2961	my $dbr = LJ::get_db_reader();
2962	my $sth = $dbr->prepare($sql);
2963	$sth->execute($u->{'userid'});
2964
2965	my @frow;
2966	while (my @row = $sth->fetchrow_array) {
2967	next if $hide{$row[0]};
2968	push @frow, [ @row ];
2969	}
2970
2971	my $us = LJ::load_userids(map { $_->[0] } @frow);
2972	my $limitnum = $opts->{'limit'}+0;
2973
2974	my $res = [];
2975	foreach my $f (sort { $us->{$a->[0]}{'user'} cmp $us->{$b->[0]}{'user'} }
2976	grep { $us->{$_->[0]} } @frow)
2977	{
2978	my $u = $us->{$f->[0]};
2979	next if $opts->{'friendof'} && $u->{'statusvis'} ne 'V';
2980
2981	my $r = {
2982	'username' => $u->{'user'},
2983	'fullname' => $u->{'name'},
2984	};
2985
2986
2987	if ($u->identity) {
2988	my $i = $u->identity;
2989	$r->{'identity_type'} = $i->pretty_type;
2990	$r->{'identity_value'} = $i->value;
2991	$r->{'identity_display'} = $u->display_name;
2992	}
2993
2994	if ($opts->{'includebdays'} &&
2995	$u->{'bdate'} &&
2996	$u->{'bdate'} ne "0000-00-00" &&
2997	$u->can_show_full_bday)
2998	{
2999	$r->{'birthday'} = $u->{'bdate'};
3000	}
3001
3002	unless ($opts->{'friendof'}) {
3003	$r->{'fgcolor'} = LJ::color_fromdb($f->[1]);
3004	$r->{'bgcolor'} = LJ::color_fromdb($f->[2]);
3005	$r->{"groupmask"} = $f->[3] if $f->[3] != 1;
3006	} else {
3007	$r->{'fgcolor'} = "#000000";
3008	$r->{'bgcolor'} = "#ffffff";
3009	}
3010
3011	$r->{"type"} = {
3012	'C' => 'community',
3013	'Y' => 'syndicated',
3014	'N' => 'news',
3015	'S' => 'shared',
3016	'I' => 'identity',
3017	}->{$u->{'journaltype'}} if $u->{'journaltype'} ne 'P';
3018
3019	$r->{"status"} = {
3020	'D' => "deleted",
3021	'S' => "suspended",
3022	'X' => "purged",
3023	}->{$u->{'statusvis'}} if $u->{'statusvis'} ne 'V';
3024
3025	$r->{defaultpicurl} = "$LJ::USERPIC_ROOT/$u->{'defaultpicid'}/$u->{'userid'}" if $u->{'defaultpicid'};
3026
3027	push @$res, $r;
3028	# won't happen for zero limit (which means no limit)
3029	last if @$res == $limitnum;
3030	}
3031	return $res;
3032	}
3033
3034	sub syncitems
3035	{
3036	my ($req, $err, $flags) = @_;
3037	return undef unless authenticate($req, $err, $flags);
3038	return undef unless check_altusage($req, $err, $flags);
3039	return fail($err,506) if $LJ::DISABLED{'syncitems'};
3040
3041	my $ownerid = $flags->{'ownerid'};
3042	my $uowner = $flags->{'u_owner'} \|\| $flags->{'u'};
3043	my $sth;
3044
3045	my $db = LJ::get_cluster_reader($uowner);
3046	return fail($err,502) unless $db;
3047
3048	## have a valid date?
3049	my $date = $req->{'lastsync'};
3050	if ($date) {
3051	return fail($err,203,"Invalid date format")
3052	unless ($date =~ /^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d/);
3053	} else {
3054	$date = "0000-00-00 00:00:00";
3055	}
3056
3057	my $LIMIT = 500;
3058
3059	my %item;
3060	$sth = $db->prepare("SELECT jitemid, logtime FROM log2 WHERE ".
3061	"journalid=? and logtime > ?");
3062	$sth->execute($ownerid, $date);
3063	while (my ($id, $dt) = $sth->fetchrow_array) {
3064	$item{$id} = [ 'L', $id, $dt, "create" ];
3065	}
3066
3067	my %cmt;
3068	my $p_calter = LJ::get_prop("log", "commentalter");
3069	my $p_revtime = LJ::get_prop("log", "revtime");
3070	$sth = $db->prepare("SELECT jitemid, propid, FROM_UNIXTIME(value) ".
3071	"FROM logprop2 WHERE journalid=? ".
3072	"AND propid IN ($p_calter->{'id'}, $p_revtime->{'id'}) ".
3073	"AND value+0 > UNIX_TIMESTAMP(?)");
3074	$sth->execute($ownerid, $date);
3075	while (my ($id, $prop, $dt) = $sth->fetchrow_array) {
3076	if ($prop == $p_calter->{'id'}) {
3077	$cmt{$id} = [ 'C', $id, $dt, "update" ];
3078	} elsif ($prop == $p_revtime->{'id'}) {
3079	$item{$id} = [ 'L', $id, $dt, "update" ];
3080	}
3081	}
3082
3083	my @ev = sort { $a->[2] cmp $b->[2] } (values %item, values %cmt);
3084
3085	my $res = {};
3086	my $list = $res->{'syncitems'} = [];
3087	$res->{'total'} = scalar @ev;
3088	my $ct = 0;
3089	while (my $ev = shift @ev) {
3090	$ct++;
3091	push @$list, { 'item' => "$ev->[0]-$ev->[1]",
3092	'time' => $ev->[2],
3093	'action' => $ev->[3], };
3094	last if $ct >= $LIMIT;
3095	}
3096	$res->{'count'} = $ct;
3097	return $res;
3098	}
3099
3100	sub consolecommand
3101	{
3102	my ($req, $err, $flags) = @_;
3103
3104	# logging in isn't necessary, but most console commands do require it
3105	LJ::set_remote($flags->{'u'}) if authenticate($req, $err, $flags);
3106
3107	my $res = {};
3108	my $cmdout = $res->{'results'} = [];
3109
3110	foreach my $cmd (@{$req->{'commands'}}) {
3111	# callee can pre-parse the args, or we can do it bash-style
3112	my @args = ref $cmd eq "ARRAY" ? @$cmd
3113	: LJ::Console->parse_line($cmd);
3114	my $c = LJ::Console->parse_array(@args);
3115	my $rv = $c->execute_safely;
3116
3117	my @output;
3118	push @output, [$_->status, $_->text] foreach $c->responses;
3119
3120	push @{$cmdout}, {
3121	'success' => $rv,
3122	'output' => \@output,
3123	};
3124	}
3125
3126	return $res;
3127	}
3128
3129	sub getchallenge
3130	{
3131	my ($req, $err, $flags) = @_;
3132	my $res = {};
3133	my $now = time();
3134	my $etime = 60;
3135	$res->{'challenge'} = LJ::challenge_generate($etime);
3136	$res->{'server_time'} = $now;
3137	$res->{'expire_time'} = $now + $etime;
3138	$res->{'auth_scheme'} = "c0"; # fixed for now, might support others later
3139	return $res;
3140	}
3141
3142	sub login_message
3143	{
3144	my ($req, $res, $flags) = @_;
3145	my $u = $flags->{'u'};
3146
3147	my $msg = sub {
3148	my $code = shift;
3149	my $args = shift \|\| {};
3150	$args->{'sitename'} = $LJ::SITENAME;
3151	$args->{'siteroot'} = $LJ::SITEROOT;
3152	my $pre = delete $args->{'pre'};
3153	$res->{'message'} = $pre . translate($u, $code, $args);
3154	};
3155
3156	return $msg->("readonly") if LJ::get_cap($u, "readonly");
3157	return $msg->("not_validated") if ($u->{'status'} eq "N" and not $LJ::EVERYONE_VALID);
3158	return $msg->("must_revalidate") if ($u->{'status'} eq "T" and not $LJ::EVERYONE_VALID);
3159
3160	my $checkpass = LJ::run_hook("bad_password", { 'u' => $u });
3161	return $msg->("bad_password", { 'pre' => "$checkpass " }) if $checkpass;
3162
3163	return $msg->("old_win32_client") if $req->{'clientversion'} =~ /^Win32-MFC\/(1.2.[0123456])$/;
3164	return $msg->("old_win32_client") if $req->{'clientversion'} =~ /^Win32-MFC\/(1.3.[01234])\b/;
3165	return $msg->("hello_test") if grep { $u->{user} eq $_ } @LJ::TESTACCTS;
3166	}
3167
3168	sub list_friendgroups
3169	{
3170	my $u = shift;
3171
3172	# get the groups for this user, return undef if error
3173	my $groups = LJ::get_friend_group($u);
3174	return undef unless $groups;
3175
3176	# we got all of the groups, so put them into an arrayref sorted by the
3177	# group sortorder; also note that the map is used to construct a new hashref
3178	# out of the old group hashref so that we have all of the field names converted
3179	# to a format our callers can recognize
3180	my @res = map { { id => $_->{groupnum}, name => $_->{groupname},
3181	public => $_->{is_public}, sortorder => $_->{sortorder}, } }
3182	sort { $a->{sortorder} <=> $b->{sortorder} }
3183	values %$groups;
3184
3185	return \@res;
3186	}
3187
3188	sub list_usejournals {
3189	my $u = shift;
3190
3191	my @us = $u->posting_access_list;
3192	my @unames = map { $_->{user} } @us;
3193
3194	return \@unames;
3195	}
3196
3197	sub hash_menus
3198	{
3199	my $u = shift;
3200	my $user = $u->{'user'};
3201
3202	my $menu = [
3203	{ 'text' => "Recent Entries",
3204	'url' => "$LJ::SITEROOT/users/$user/", },
3205	{ 'text' => "Calendar View",
3206	'url' => "$LJ::SITEROOT/users/$user/calendar", },
3207	{ 'text' => "Friends View",
3208	'url' => "$LJ::SITEROOT/users/$user/friends", },
3209	{ 'text' => "-", },
3210	{ 'text' => "Your Profile",
3211	'url' => "$LJ::SITEROOT/userinfo.bml?user=$user", },
3212	{ 'text' => "Your To-Do List",
3213	'url' => "$LJ::SITEROOT/todo/?user=$user", },
3214	{ 'text' => "-", },
3215	{ 'text' => "Change Settings",
3216	'sub' => [ { 'text' => "Personal Info",
3217	'url' => "$LJ::SITEROOT/manage/profile/", },
3218	{ 'text' => "Customize Journal",
3219	'url' =>"$LJ::SITEROOT/customize/", }, ] },
3220	{ 'text' => "-", },
3221	{ 'text' => "Support",
3222	'url' => "$LJ::SITEROOT/support/", }
3223	];
3224
3225	LJ::run_hooks("modify_login_menu", {
3226	'menu' => $menu,
3227	'u' => $u,
3228	'user' => $user,
3229	});
3230
3231	return $menu;
3232	}
3233
3234	sub list_pickws
3235	{
3236	my $u = shift;
3237
3238	my $pi = LJ::get_userpic_info($u);
3239	my @res;
3240
3241	my %seen; # mashifiedptr -> 1
3242
3243	# FIXME: should be a utf-8 sort
3244	foreach my $kw (sort keys %{$pi->{'kw'}}) {
3245	my $pic = $pi->{'kw'}{$kw};
3246	$seen{$pic} = 1;
3247	next if $pic->{'state'} eq "I";
3248	push @res, [ $kw, $pic->{'picid'} ];
3249	}
3250
3251	# now add all the pictures that don't have a keyword
3252	foreach my $picid (keys %{$pi->{'pic'}}) {
3253	my $pic = $pi->{'pic'}{$picid};
3254	next if $seen{$pic};
3255	push @res, [ "pic#$picid", $picid ];
3256	}
3257
3258	return \@res;
3259	}
3260
3261	sub list_moods
3262	{
3263	my $mood_max = int(shift);
3264	LJ::load_moods();
3265
3266	my $res = [];
3267	return $res if $mood_max >= $LJ::CACHED_MOOD_MAX;
3268
3269	for (my $id = $mood_max+1; $id <= $LJ::CACHED_MOOD_MAX; $id++) {
3270	next unless defined $LJ::CACHE_MOODS{$id};
3271	my $mood = $LJ::CACHE_MOODS{$id};
3272	next unless $mood->{'name'};
3273	push @$res, { 'id' => $id,
3274	'name' => $mood->{'name'},
3275	'parent' => $mood->{'parent'} };
3276	}
3277
3278	return $res;
3279	}
3280
3281	sub check_altusage
3282	{
3283	my ($req, $err, $flags) = @_;
3284
3285	# see note in ljlib.pl::can_use_journal about why we return
3286	# both 'ownerid' and 'u_owner' in $flags
3287
3288	my $alt = $req->{'usejournal'};
3289	my $u = $flags->{'u'};
3290	unless ($u) {
3291	my $username = $req->{'username'};
3292	return fail($err,200) unless $username;
3293	return fail($err,100) unless LJ::canonical_username($username);
3294
3295	my $dbr = LJ::get_db_reader();
3296	return fail($err,502) unless $dbr;
3297	$u = $flags->{'u'} = LJ::load_user($username);
3298	}
3299
3300	$flags->{'ownerid'} = $u->{'userid'};
3301
3302	# all good if not using an alt journal
3303	return 1 unless $alt;
3304
3305	# complain if the username is invalid
3306	return fail($err,206) unless LJ::canonical_username($alt);
3307
3308	# allow usage if we're told explicitly that it's okay
3309	if ($flags->{'usejournal_okay'}) {
3310	$flags->{'u_owner'} = LJ::load_user($alt);
3311	$flags->{'ownerid'} = $flags->{'u_owner'}->{'userid'};
3312	LJ::Request->notes("journalid" => $flags->{'ownerid'}) if LJ::Request->is_inited && !LJ::Request->notes("journalid");
3313	return 1 if $flags->{'ownerid'};
3314	return fail($err,206);
3315	}
3316
3317	# otherwise, check for access:
3318	my $info = {};
3319	my $canuse = LJ::can_use_journal($u->{'userid'}, $alt, $info);
3320	$flags->{'ownerid'} = $info->{'ownerid'};
3321	$flags->{'u_owner'} = $info->{'u_owner'};
3322	LJ::Request->notes("journalid" => $flags->{'ownerid'}) if LJ::Request->is_inited && !LJ::Request->notes("journalid");
3323
3324	return 1 if $canuse \|\| $flags->{'ignorecanuse'};
3325
3326	# not allowed to access it
3327	return fail($err,300);
3328	}
3329
3330	sub authenticate
3331	{
3332	my ($req, $err, $flags) = @_;
3333
3334	my $username = $req->{'username'};
3335	return fail($err,200) unless $username;
3336	return fail($err,100) unless LJ::canonical_username($username);
3337
3338	my $u = $flags->{'u'};
3339	unless ($u) {
3340	my $dbr = LJ::get_db_reader();
3341	return fail($err,502) unless $dbr;
3342	$u = LJ::load_user($username);
3343	}
3344
3345	return fail($err,100) unless $u;
3346	return fail($err,100) if ($u->{'statusvis'} eq "X");
3347	return fail($err,505) unless $u->{'clusterid'};
3348
3349	my $ip;
3350	if (LJ::Request->is_inited) {
3351	LJ::Request->notes("ljuser" => $u->{'user'}) unless LJ::Request->notes("ljuser");
3352	LJ::Request->notes("journalid" => $u->{'userid'}) unless LJ::Request->notes("journalid");
3353	$ip = LJ::Request->connection->remote_ip;
3354	}
3355
3356	my $ip_banned = 0;
3357	my $chal_expired = 0;
3358	my $auth_check = sub {
3359
3360	my $auth_meth = $req->{'auth_method'} \|\| "clear";
3361	if ($auth_meth eq "clear") {
3362	return LJ::auth_okay($u,
3363	$req->{'password'},
3364	$req->{'hpassword'},
3365	$u->password,
3366	\$ip_banned);
3367	}
3368	if ($auth_meth eq "challenge") {
3369	my $chal_opts = {};
3370	my $chall_ok = LJ::challenge_check_login($u,
3371	$req->{'auth_challenge'},
3372	$req->{'auth_response'},
3373	\$ip_banned,
3374	$chal_opts);
3375	$chal_expired = 1 if $chal_opts->{expired};
3376	return $chall_ok;
3377	}
3378	if ($auth_meth eq "cookie") {
3379	return unless LJ::Request->is_inited && LJ::Request->header_in("X-LJ-Auth") eq "cookie";
3380	my $remote = LJ::get_remote();
3381	return $remote && $remote->{'user'} eq $username ? 1 : 0;
3382	}
3383	};
3384
3385	unless ($flags->{'nopassword'} \|\|
3386	$flags->{'noauth'} \|\|
3387	$auth_check->() )
3388	{
3389	return fail($err,402) if $ip_banned;
3390	return fail($err,105) if $chal_expired;
3391	return fail($err,101);
3392	}
3393
3394	# if there is a require TOS revision, check for it now
3395	return fail($err, 156, LJ::tosagree_str('protocol' => 'text'))
3396	unless $u->tosagree_verify;
3397
3398	# remember the user record for later.
3399	$flags->{'u'} = $u;
3400	return 1;
3401	}
3402
3403	sub fail
3404	{
3405	my $err = shift;
3406	my $code = shift;
3407	my $des = shift;
3408	$code .= ":$des" if $des;
3409	$$err = $code if (ref $err eq "SCALAR");
3410	return undef;
3411	}
3412
3413	# PROBLEM: a while back we used auto_increment fields in our tables so that we could have
3414	# automatically incremented itemids and such. this was eventually phased out in favor of
3415	# the more portable alloc_user_counter function which uses the 'counter' table. when the
3416	# counter table has no data, it finds the highest id already in use in the database and adds
3417	# one to it.
3418	#
3419	# a problem came about when users who last posted before alloc_user_counter went
3420	# and deleted all their entries and posted anew. alloc_user_counter would find no entries,
3421	# this no ids, and thus assign id 1, thinking it's all clean and new. but, id 1 had been
3422	# used previously, and now has comments attached to it.
3423	#
3424	# the comments would happen because there was an old bug that wouldn't delete comments when
3425	# an entry was deleted. this has since been fixed. so this all combines to make this
3426	# a necessity, at least until no buggy data exist anymore!
3427	#
3428	# this code here removes any comments that happen to exist for the id we're now using.
3429	sub new_entry_cleanup_hack {
3430	my ($u, $jitemid) = @_;
3431
3432	# sanitize input
3433	$jitemid += 0;
3434	return unless $jitemid;
3435	my $ownerid = LJ::want_userid($u);
3436	return unless $ownerid;
3437
3438	# delete logprops
3439	$u->do("DELETE FROM logprop2 WHERE journalid=$ownerid AND jitemid=$jitemid");
3440
3441	# delete comments
3442	my $ids = LJ::Talk::get_talk_data($u, 'L', $jitemid);
3443	return unless ref $ids eq 'HASH' && %$ids;
3444	my $list = join ',', map { $_+0 } keys %$ids;
3445	$u->do("DELETE FROM talk2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
3446	$u->do("DELETE FROM talktext2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
3447	$u->do("DELETE FROM talkprop2 WHERE journalid=$ownerid AND jtalkid IN ($list)");
3448	}
3449
3450	sub un_utf8_request {
3451	my $req = shift;
3452	$req->{$_} = LJ::no_utf8_flag($req->{$_}) foreach qw(subject event);
3453	my $props = $req->{props} \|\| {};
3454	foreach my $k (keys %$props) {
3455	next if ref $props->{$k}; # if this is multiple levels deep? don't think so.
3456	$props->{$k} = LJ::no_utf8_flag($props->{$k});
3457	}
3458	}
3459
3460	#### Old interface (flat key/values) -- wrapper aruond LJ::Protocol
3461	package LJ;
3462
3463	sub do_request
3464	{
3465	# get the request and response hash refs
3466	my ($req, $res, $flags) = @_;
3467
3468	# initialize some stuff
3469	%{$res} = (); # clear the given response hash
3470	$flags = {} unless (ref $flags eq "HASH");
3471
3472	# did they send a mode?
3473	unless ($req->{'mode'}) {
3474	$res->{'success'} = "FAIL";
3475	$res->{'errmsg'} = "Client error: No mode specified.";
3476	return;
3477	}
3478
3479	# this method doesn't require auth
3480	if ($req->{'mode'} eq "getchallenge") {
3481	return getchallenge($req, $res, $flags);
3482	}
3483
3484	# mode from here on out require a username
3485	my $user = LJ::canonical_username($req->{'user'});
3486	unless ($user) {
3487	$res->{'success'} = "FAIL";
3488	$res->{'errmsg'} = "Client error: No username sent.";
3489	return;
3490	}
3491
3492	### see if the server's under maintenance now
3493	if ($LJ::SERVER_DOWN) {
3494	$res->{'success'} = "FAIL";
3495	$res->{'errmsg'} = $LJ::SERVER_DOWN_MESSAGE;
3496	return;
3497	}
3498
3499	## dispatch wrappers
3500	if ($req->{'mode'} eq "login") {
3501	return login($req, $res, $flags);
3502	}
3503	if ($req->{'mode'} eq "getfriendgroups") {
3504	return getfriendgroups($req, $res, $flags);
3505	}
3506	if ($req->{'mode'} eq "getfriends") {
3507	return getfriends($req, $res, $flags);
3508	}
3509	if ($req->{'mode'} eq "friendof") {
3510	return friendof($req, $res, $flags);
3511	}
3512	if ($req->{'mode'} eq "checkfriends") {
3513	return checkfriends($req, $res, $flags);
3514	}
3515	if ($req->{'mode'} eq "getdaycounts") {
3516	return getdaycounts($req, $res, $flags);
3517	}
3518	if ($req->{'mode'} eq "postevent") {
3519	return postevent($req, $res, $flags);
3520	}
3521	if ($req->{'mode'} eq "editevent") {
3522	return editevent($req, $res, $flags);
3523	}
3524	if ($req->{'mode'} eq "syncitems") {
3525	return syncitems($req, $res, $flags);
3526	}
3527	if ($req->{'mode'} eq "getevents") {
3528	return getevents($req, $res, $flags);
3529	}
3530	if ($req->{'mode'} eq "editfriends") {
3531	return editfriends($req, $res, $flags);
3532	}
3533	if ($req->{'mode'} eq "editfriendgroups") {
3534	return editfriendgroups($req, $res, $flags);
3535	}
3536	if ($req->{'mode'} eq "consolecommand") {
3537	return consolecommand($req, $res, $flags);
3538	}
3539	if ($req->{'mode'} eq "sessiongenerate") {
3540	return sessiongenerate($req, $res, $flags);
3541	}
3542	if ($req->{'mode'} eq "sessionexpire") {
3543	return sessionexpire($req, $res, $flags);
3544	}
3545	if ($req->{'mode'} eq "getusertags") {
3546	return getusertags($req, $res, $flags);
3547	}
3548	if ($req->{'mode'} eq "getfriendspage") {
3549	return getfriendspage($req, $res, $flags);
3550	}
3551
3552	### unknown mode!
3553	$res->{'success'} = "FAIL";
3554	$res->{'errmsg'} = "Client error: Unknown mode ($req->{'mode'})";
3555	return;
3556	}
3557
3558	## flat wrapper
3559	sub getfriendspage
3560	{
3561	my ($req, $res, $flags) = @_;
3562
3563	my $err = 0;
3564	my $rq = upgrade_request($req);
3565
3566	my $rs = LJ::Protocol::do_request("getfriendspage", $rq, \$err, $flags);
3567	unless ($rs) {
3568	$res->{'success'} = "FAIL";
3569	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3570	return 0;
3571	}
3572
3573	my $ect = 0;
3574	foreach my $evt (@{$rs->{'entries'}}) {
3575	$ect++;
3576	foreach my $f (qw(subject_raw journalname journaltype postername postertype ditemid security)) {
3577	if (defined $evt->{$f}) {
3578	$res->{"entries_${ect}_$f"} = $evt->{$f};
3579	}
3580	}
3581	$res->{"entries_${ect}_event"} = LJ::eurl($evt->{'event_raw'});
3582	}
3583
3584	$res->{'entries_count'} = $ect;
3585	$res->{'success'} = "OK";
3586
3587	return 1;
3588	}
3589
3590	## flat wrapper
3591	sub login
3592	{
3593	my ($req, $res, $flags) = @_;
3594
3595	my $err = 0;
3596	my $rq = upgrade_request($req);
3597
3598	my $rs = LJ::Protocol::do_request("login", $rq, \$err, $flags);
3599	unless ($rs) {
3600	$res->{'success'} = "FAIL";
3601	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3602	return 0;
3603	}
3604
3605	$res->{'success'} = "OK";
3606	$res->{'name'} = $rs->{'fullname'};
3607	$res->{'message'} = $rs->{'message'} if $rs->{'message'};
3608	$res->{'fastserver'} = 1 if $rs->{'fastserver'};
3609	$res->{'caps'} = $rs->{'caps'} if $rs->{'caps'};
3610
3611	# shared journals
3612	my $access_count = 0;
3613	foreach my $user (@{$rs->{'usejournals'}}) {
3614	$access_count++;
3615	$res->{"access_${access_count}"} = $user;
3616	}
3617	if ($access_count) {
3618	$res->{"access_count"} = $access_count;
3619	}
3620
3621	# friend groups
3622	populate_friend_groups($res, $rs->{'friendgroups'});
3623
3624	my $flatten = sub {
3625	my ($prefix, $listref) = @_;
3626	my $ct = 0;
3627	foreach (@$listref) {
3628	$ct++;
3629	$res->{"${prefix}_$ct"} = $_;
3630	}
3631	$res->{"${prefix}_count"} = $ct;
3632	};
3633
3634	### picture keywords
3635	$flatten->("pickw", $rs->{'pickws'})
3636	if defined $req->{"getpickws"};
3637	$flatten->("pickwurl", $rs->{'pickwurls'})
3638	if defined $req->{"getpickwurls"};
3639	$res->{'defaultpicurl'} = $rs->{'defaultpicurl'} if $rs->{'defaultpicurl'};
3640
3641	### report new moods that this client hasn't heard of, if they care
3642	if (defined $req->{"getmoods"}) {
3643	my $mood_count = 0;
3644	foreach my $m (@{$rs->{'moods'}}) {
3645	$mood_count++;
3646	$res->{"mood_${mood_count}_id"} = $m->{'id'};
3647	$res->{"mood_${mood_count}_name"} = $m->{'name'};
3648	$res->{"mood_${mood_count}_parent"} = $m->{'parent'};
3649	}
3650	if ($mood_count) {
3651	$res->{"mood_count"} = $mood_count;
3652	}
3653	}
3654
3655	#### send web menus
3656	if ($req->{"getmenus"} == 1) {
3657	my $menu = $rs->{'menus'};
3658	my $menu_num = 0;
3659	populate_web_menu($res, $menu, \$menu_num);
3660	}
3661
3662	return 1;
3663	}
3664
3665	## flat wrapper
3666	sub getfriendgroups
3667	{
3668	my ($req, $res, $flags) = @_;
3669
3670	my $err = 0;
3671	my $rq = upgrade_request($req);
3672
3673	my $rs = LJ::Protocol::do_request("getfriendgroups", $rq, \$err, $flags);
3674	unless ($rs) {
3675	$res->{'success'} = "FAIL";
3676	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3677	return 0;
3678	}
3679	$res->{'success'} = "OK";
3680	populate_friend_groups($res, $rs->{'friendgroups'});
3681
3682	return 1;
3683	}
3684
3685	## flat wrapper
3686	sub getusertags
3687	{
3688	my ($req, $res, $flags) = @_;
3689
3690	my $err = 0;
3691	my $rq = upgrade_request($req);
3692
3693	my $rs = LJ::Protocol::do_request("getusertags", $rq, \$err, $flags);
3694	unless ($rs) {
3695	$res->{'success'} = "FAIL";
3696	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3697	return 0;
3698	}
3699
3700	$res->{'success'} = "OK";
3701
3702	my $ct = 0;
3703	foreach my $tag (@{$rs->{tags}}) {
3704	$ct++;
3705	$res->{"tag_${ct}_security"} = $tag->{security_level};
3706	$res->{"tag_${ct}_uses"} = $tag->{uses} if $tag->{uses};
3707	$res->{"tag_${ct}_display"} = $tag->{display} if $tag->{display};
3708	$res->{"tag_${ct}_name"} = $tag->{name};
3709	foreach my $lev (qw(friends private public)) {
3710	$res->{"tag_${ct}_sb_$_"} = $tag->{security}->{$_}
3711	if $tag->{security}->{$_};
3712	}
3713	my $gm = 0;
3714	foreach my $grpid (keys %{$tag->{security}->{groups}}) {
3715	next unless $tag->{security}->{groups}->{$grpid};
3716	$gm++;
3717	$res->{"tag_${ct}_sb_group_${gm}_id"} = $grpid;
3718	$res->{"tag_${ct}_sb_group_${gm}_count"} = $tag->{security}->{groups}->{$grpid};
3719	}
3720	$res->{"tag_${ct}_sb_group_count"} = $gm if $gm;
3721	}
3722	$res->{'tag_count'} = $ct;
3723
3724	return 1;
3725	}
3726
3727	## flat wrapper
3728	sub getfriends
3729	{
3730	my ($req, $res, $flags) = @_;
3731
3732	my $err = 0;
3733	my $rq = upgrade_request($req);
3734
3735	my $rs = LJ::Protocol::do_request("getfriends", $rq, \$err, $flags);
3736	unless ($rs) {
3737	$res->{'success'} = "FAIL";
3738	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3739	return 0;
3740	}
3741
3742	$res->{'success'} = "OK";
3743	if ($req->{'includegroups'}) {
3744	populate_friend_groups($res, $rs->{'friendgroups'});
3745	}
3746	if ($req->{'includefriendof'}) {
3747	populate_friends($res, "friendof", $rs->{'friendofs'});
3748	}
3749	populate_friends($res, "friend", $rs->{'friends'});
3750
3751	return 1;
3752	}
3753
3754	## flat wrapper
3755	sub friendof
3756	{
3757	my ($req, $res, $flags) = @_;
3758
3759	my $err = 0;
3760	my $rq = upgrade_request($req);
3761
3762	my $rs = LJ::Protocol::do_request("friendof", $rq, \$err, $flags);
3763	unless ($rs) {
3764	$res->{'success'} = "FAIL";
3765	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3766	return 0;
3767	}
3768
3769	$res->{'success'} = "OK";
3770	populate_friends($res, "friendof", $rs->{'friendofs'});
3771	return 1;
3772	}
3773
3774	## flat wrapper
3775	sub checkfriends
3776	{
3777	my ($req, $res, $flags) = @_;
3778
3779	my $err = 0;
3780	my $rq = upgrade_request($req);
3781
3782	my $rs = LJ::Protocol::do_request("checkfriends", $rq, \$err, $flags);
3783	unless ($rs) {
3784	$res->{'success'} = "FAIL";
3785	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3786	return 0;
3787	}
3788
3789	$res->{'success'} = "OK";
3790	$res->{'new'} = $rs->{'new'};
3791	$res->{'lastupdate'} = $rs->{'lastupdate'};
3792	$res->{'interval'} = $rs->{'interval'};
3793	return 1;
3794	}
3795
3796	## flat wrapper
3797	sub getdaycounts
3798	{
3799	my ($req, $res, $flags) = @_;
3800
3801	my $err = 0;
3802	my $rq = upgrade_request($req);
3803
3804	my $rs = LJ::Protocol::do_request("getdaycounts", $rq, \$err, $flags);
3805	unless ($rs) {
3806	$res->{'success'} = "FAIL";
3807	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3808	return 0;
3809	}
3810
3811	$res->{'success'} = "OK";
3812	foreach my $d (@{ $rs->{'daycounts'} }) {
3813	$res->{$d->{'date'}} = $d->{'count'};
3814	}
3815	return 1;
3816	}
3817
3818	## flat wrapper
3819	sub syncitems
3820	{
3821	my ($req, $res, $flags) = @_;
3822
3823	my $err = 0;
3824	my $rq = upgrade_request($req);
3825
3826	my $rs = LJ::Protocol::do_request("syncitems", $rq, \$err, $flags);
3827	unless ($rs) {
3828	$res->{'success'} = "FAIL";
3829	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3830	return 0;
3831	}
3832
3833	$res->{'success'} = "OK";
3834	$res->{'sync_total'} = $rs->{'total'};
3835	$res->{'sync_count'} = $rs->{'count'};
3836
3837	my $ct = 0;
3838	foreach my $s (@{ $rs->{'syncitems'} }) {
3839	$ct++;
3840	foreach my $a (qw(item action time)) {
3841	$res->{"sync_${ct}_$a"} = $s->{$a};
3842	}
3843	}
3844	return 1;
3845	}
3846
3847	## flat wrapper: limited functionality. (1 command only, server-parsed only)
3848	sub consolecommand
3849	{
3850	my ($req, $res, $flags) = @_;
3851
3852	my $err = 0;
3853	my $rq = upgrade_request($req);
3854	delete $rq->{'command'};
3855
3856	$rq->{'commands'} = [ $req->{'command'} ];
3857
3858	my $rs = LJ::Protocol::do_request("consolecommand", $rq, \$err, $flags);
3859	unless ($rs) {
3860	$res->{'success'} = "FAIL";
3861	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3862	return 0;
3863	}
3864
3865	$res->{'cmd_success'} = $rs->{'results'}->[0]->{'success'};
3866	$res->{'cmd_line_count'} = 0;
3867	foreach my $l (@{$rs->{'results'}->[0]->{'output'}}) {
3868	$res->{'cmd_line_count'}++;
3869	my $line = $res->{'cmd_line_count'};
3870	$res->{"cmd_line_${line}_type"} = $l->[0]
3871	if $l->[0];
3872	$res->{"cmd_line_${line}"} = $l->[1];
3873	}
3874
3875	$res->{'success'} = "OK";
3876
3877	}
3878
3879	## flat wrapper
3880	sub getchallenge
3881	{
3882	my ($req, $res, $flags) = @_;
3883	my $err = 0;
3884	my $rs = LJ::Protocol::do_request("getchallenge", $req, \$err, $flags);
3885
3886	# stupid copy (could just return $rs), but it might change in the future
3887	# so this protects us from future accidental harm.
3888	foreach my $k (qw(challenge server_time expire_time auth_scheme)) {
3889	$res->{$k} = $rs->{$k};
3890	}
3891
3892	$res->{'success'} = "OK";
3893	return $res;
3894	}
3895
3896	## flat wrapper
3897	sub editfriends
3898	{
3899	my ($req, $res, $flags) = @_;
3900
3901	my $err = 0;
3902	my $rq = upgrade_request($req);
3903
3904	$rq->{'add'} = [];
3905	$rq->{'delete'} = [];
3906
3907	foreach (keys %$req) {
3908	if (/^editfriend_add_(\d+)_user$/) {
3909	my $n = $1;
3910	next unless ($req->{"editfriend_add_${n}_user"} =~ /\S/);
3911	my $fa = { 'username' => $req->{"editfriend_add_${n}_user"},
3912	'fgcolor' => $req->{"editfriend_add_${n}_fg"},
3913	'bgcolor' => $req->{"editfriend_add_${n}_bg"},
3914	'groupmask' => $req->{"editfriend_add_${n}_groupmask"},
3915	};
3916	push @{$rq->{'add'}}, $fa;
3917	} elsif (/^editfriend_delete_(\w+)$/) {
3918	push @{$rq->{'delete'}}, $1;
3919	}
3920	}
3921
3922	my $rs = LJ::Protocol::do_request("editfriends", $rq, \$err, $flags);
3923	unless ($rs) {
3924	$res->{'success'} = "FAIL";
3925	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3926	return 0;
3927	}
3928
3929	$res->{'success'} = "OK";
3930
3931	my $ct = 0;
3932	foreach my $fa (@{ $rs->{'added'} }) {
3933	$ct++;
3934	$res->{"friend_${ct}_user"} = $fa->{'username'};
3935	$res->{"friend_${ct}_name"} = $fa->{'fullname'};
3936	}
3937
3938	$res->{'friends_added'} = $ct;
3939
3940	return 1;
3941	}
3942
3943	## flat wrapper
3944	sub editfriendgroups
3945	{
3946	my ($req, $res, $flags) = @_;
3947
3948	my $err = 0;
3949	my $rq = upgrade_request($req);
3950
3951	$rq->{'groupmasks'} = {};
3952	$rq->{'set'} = {};
3953	$rq->{'delete'} = [];
3954
3955	foreach (keys %$req) {
3956	if (/^efg_set_(\d+)_name$/) {
3957	next unless ($req->{$_} ne "");
3958	my $n = $1;
3959	my $fs = {
3960	'name' => $req->{"efg_set_${n}_name"},
3961	'sort' => $req->{"efg_set_${n}_sort"},
3962	};
3963	if (defined $req->{"efg_set_${n}_public"}) {
3964	$fs->{'public'} = $req->{"efg_set_${n}_public"};
3965	}
3966	$rq->{'set'}->{$n} = $fs;
3967	}
3968	elsif (/^efg_delete_(\d+)$/) {
3969	if ($req->{$_}) {
3970	# delete group if value is true
3971	push @{$rq->{'delete'}}, $1;
3972	}
3973	}
3974	elsif (/^editfriend_groupmask_(\w+)$/) {
3975	$rq->{'groupmasks'}->{$1} = $req->{$_};
3976	}
3977	}
3978
3979	my $rs = LJ::Protocol::do_request("editfriendgroups", $rq, \$err, $flags);
3980	unless ($rs) {
3981	$res->{'success'} = "FAIL";
3982	$res->{'errmsg'} = LJ::Protocol::error_message($err);
3983	return 0;
3984	}
3985
3986	$res->{'success'} = "OK";
3987	return 1;
3988	}
3989
3990	sub flatten_props
3991	{
3992	my ($req, $rq) = @_;
3993
3994	## changes prop_* to props hashref
3995	foreach my $k (keys %$req) {
3996	next unless ($k =~ /^prop_(.+)/);
3997	$rq->{'props'}->{$1} = $req->{$k};
3998	}
3999	}
4000
4001	## flat wrapper
4002	sub postevent
4003	{
4004	my ($req, $res, $flags) = @_;
4005
4006	my $err = 0;
4007	my $rq = upgrade_request($req);
4008	flatten_props($req, $rq);
4009	$rq->{'props'}->{'interface'} = "flat";
4010
4011	my $rs = LJ::Protocol::do_request("postevent", $rq, \$err, $flags);
4012	unless ($rs) {
4013	$res->{'success'} = "FAIL";
4014	$res->{'errmsg'} = LJ::Protocol::error_message($err);
4015	return 0;
4016	}
4017
4018	$res->{'message'} = $rs->{'message'} if $rs->{'message'};
4019	$res->{'extra_result_message'} = $rs->{'extra_result_message'} if $rs->{'extra_result_message'};
4020	$res->{'success'} = "OK";
4021	$res->{'itemid'} = $rs->{'itemid'};
4022	$res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
4023	$res->{'url'} = $rs->{'url'} if defined $rs->{'url'};
4024	# we may not translate 'warnings' here, because it may contain \n characters
4025	return 1;
4026	}
4027
4028	## flat wrapper
4029	sub editevent
4030	{
4031	my ($req, $res, $flags) = @_;
4032
4033	my $err = 0;
4034	my $rq = upgrade_request($req);
4035	flatten_props($req, $rq);
4036
4037	my $rs = LJ::Protocol::do_request("editevent", $rq, \$err, $flags);
4038	unless ($rs) {
4039	$res->{'success'} = "FAIL";
4040	$res->{'errmsg'} = LJ::Protocol::error_message($err);
4041	return 0;
4042	}
4043
4044	$res->{'success'} = "OK";
4045	$res->{'itemid'} = $rs->{'itemid'};
4046	$res->{'anum'} = $rs->{'anum'} if defined $rs->{'anum'};
4047	$res->{'url'} = $rs->{'url'} if defined $rs->{'url'};
4048	return 1;
4049	}
4050
4051	## flat wrapper
4052	sub sessiongenerate {
4053	my ($req, $res, $flags) = @_;
4054
4055	my $err = 0;
4056	my $rq = upgrade_request($req);
4057
4058	my $rs = LJ::Protocol::do_request('sessiongenerate', $rq, \$err, $flags);
4059	unless ($rs) {
4060	$res->{success} = 'FAIL';
4061	$res->{errmsg} = LJ::Protocol::error_message($err);
4062	}
4063
4064	$res->{success} = 'OK';
4065	$res->{ljsession} = $rs->{ljsession};
4066	return 1;
4067	}
4068
4069	## flat wrappre
4070	sub sessionexpire {
4071	my ($req, $res, $flags) = @_;
4072
4073	my $err = 0;
4074	my $rq = upgrade_request($req);
4075
4076	$rq->{expire} = [];
4077	foreach my $k (keys %$rq) {
4078	push @{$rq->{expire}}, $1
4079	if $k =~ /^expire_id_(\d+)$/;
4080	}
4081
4082	my $rs = LJ::Protocol::do_request('sessionexpire', $rq, \$err, $flags);
4083	unless ($rs) {
4084	$res->{success} = 'FAIL';
4085	$res->{errmsg} = LJ::Protocol::error_message($err);
4086	}
4087
4088	$res->{success} = 'OK';
4089	return 1;
4090	}
4091
4092	## flat wrapper
4093	sub getevents
4094	{
4095	my ($req, $res, $flags) = @_;
4096
4097	my $err = 0;
4098	my $rq = upgrade_request($req);
4099
4100	my $rs = LJ::Protocol::do_request("getevents", $rq, \$err, $flags);
4101	unless ($rs) {
4102	$res->{'success'} = "FAIL";
4103	$res->{'errmsg'} = LJ::Protocol::error_message($err);
4104	return 0;
4105	}
4106
4107	my $ect = 0;
4108	my $pct = 0;
4109	foreach my $evt (@{$rs->{'events'}}) {
4110	$ect++;
4111	foreach my $f (qw(itemid eventtime security allowmask subject anum url poster)) {
4112	if (defined $evt->{$f}) {
4113	$res->{"events_${ect}_$f"} = $evt->{$f};
4114	}
4115	}
4116	$res->{"events_${ect}_event"} = LJ::eurl($evt->{'event'});
4117
4118	if ($evt->{'props'}) {
4119	foreach my $k (sort keys %{$evt->{'props'}}) {
4120	$pct++;
4121	$res->{"prop_${pct}_itemid"} = $evt->{'itemid'};
4122	$res->{"prop_${pct}_name"} = $k;
4123	$res->{"prop_${pct}_value"} = $evt->{'props'}->{$k};
4124	}
4125	}
4126	}
4127
4128	unless ($req->{'noprops'}) {
4129	$res->{'prop_count'} = $pct;
4130	}
4131	$res->{'events_count'} = $ect;
4132	$res->{'success'} = "OK";
4133
4134	return 1;
4135	}
4136
4137
4138	sub populate_friends
4139	{
4140	my ($res, $pfx, $list) = @_;
4141	my $count = 0;
4142	foreach my $f (@$list)
4143	{
4144	$count++;
4145	$res->{"${pfx}_${count}_name"} = $f->{'fullname'};
4146	$res->{"${pfx}_${count}_user"} = $f->{'username'};
4147	$res->{"${pfx}_${count}_birthday"} = $f->{'birthday'} if $f->{'birthday'};
4148	$res->{"${pfx}_${count}_bg"} = $f->{'bgcolor'};
4149	$res->{"${pfx}_${count}_fg"} = $f->{'fgcolor'};
4150	if (defined $f->{'groupmask'}) {
4151	$res->{"${pfx}_${count}_groupmask"} = $f->{'groupmask'};
4152	}
4153	if (defined $f->{'type'}) {
4154	$res->{"${pfx}_${count}_type"} = $f->{'type'};
4155	if ($f->{'type'} eq 'identity') {
4156	$res->{"${pfx}_${count}_identity_type"} = $f->{'identity_type'};
4157	$res->{"${pfx}_${count}_identity_value"} = $f->{'identity_value'};
4158	$res->{"${pfx}_${count}_identity_display"} = $f->{'identity_display'};
4159	}
4160	}
4161	if (defined $f->{'status'}) {
4162	$res->{"${pfx}_${count}_status"} = $f->{'status'};
4163	}
4164	}
4165	$res->{"${pfx}_count"} = $count;
4166	}
4167
4168
4169	sub upgrade_request
4170	{
4171	my $r = shift;
4172	my $new = { %{ $r } };
4173	$new->{'username'} = $r->{'user'};
4174
4175	# but don't delete $r->{'user'}, as it might be, say, %FORM,
4176	# that'll get reused in a later request in, say, update.bml after
4177	# the login before postevent. whoops.
4178
4179	return $new;
4180	}
4181
4182	## given a $res hashref and friend group subtree (arrayref), flattens it
4183	sub populate_friend_groups
4184	{
4185	my ($res, $fr) = @_;
4186
4187	my $maxnum = 0;
4188	foreach my $fg (@$fr)
4189	{
4190	my $num = $fg->{'id'};
4191	$res->{"frgrp_${num}_name"} = $fg->{'name'};
4192	$res->{"frgrp_${num}_sortorder"} = $fg->{'sortorder'};
4193	if ($fg->{'public'}) {
4194	$res->{"frgrp_${num}_public"} = 1;
4195	}
4196	if ($num > $maxnum) { $maxnum = $num; }
4197	}
4198	$res->{'frgrp_maxnum'} = $maxnum;
4199	}
4200
4201	## given a menu tree, flattens it into $res hashref
4202	sub populate_web_menu
4203	{
4204	my ($res, $menu, $numref) = @_;
4205	my $mn = $$numref; # menu number
4206	my $mi = 0; # menu item
4207	foreach my $it (@$menu) {
4208	$mi++;
4209	$res->{"menu_${mn}_${mi}_text"} = $it->{'text'};
4210	if ($it->{'text'} eq "-") { next; }
4211	if ($it->{'sub'}) {
4212	$$numref++;
4213	$res->{"menu_${mn}_${mi}_sub"} = $$numref;
4214	&populate_web_menu($res, $it->{'sub'}, $numref);
4215	next;
4216
4217	}
4218	$res->{"menu_${mn}_${mi}_url"} = $it->{'url'};
4219	}
4220	$res->{"menu_${mn}_count"} = $mi;
4221	}
4222
4223	1;

Note: See TracBrowser for help on using the browser.

Context Navigation

root/trunk/cgi-bin/ljprotocol.pl

Download in other formats: