Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

* import r26.1 livejournal

  • Loading branch information...
commit e7bfae8e4811d0ac7fb08cef5cc34456d150dce0 1 parent 340c2b1
@zorkian zorkian authored
Showing with 42,574 additions and 2 deletions.
  1. +379 −0 LICENSE
  2. +13 −2 README
  3. +29 −0 bin/bootstrap.pl
  4. +15 −0 bin/build-usersearch
  5. +279 −0 bin/checkconfig.pl
  6. +38 −0 bin/cvsreport.pl
  7. +369 −0 bin/dbcheck.pl
  8. +157 −0 bin/deleteusers.pl
  9. +27 −0 bin/dev/entrydump.pl
  10. +27 −0 bin/dev/inject_sms.pl
  11. +217 −0 bin/dumpsql.pl
  12. +179 −0 bin/evwatch
  13. +53 −0 bin/fakesms-djabberd
  14. +144 −0 bin/fingerd.pl
  15. +166 −0 bin/gens2editlib.pl
  16. +105 −0 bin/incoming-mail-inject.pl
  17. +45 −0 bin/lj-repo-own
  18. +35 −0 bin/lj-upgrade
  19. +631 −0 bin/ljblockwatcher.pl
  20. +110 −0 bin/ljdb
  21. +151 −0 bin/ljmaint.pl
  22. +236 −0 bin/ljsysban.pl
  23. +46 −0 bin/ljtalkd
  24. +1,151 −0 bin/ljubackup.pl
  25. +1,336 −0 bin/ljumover.pl
  26. +3 −0  bin/ljwhich
  27. +110 −0 bin/logsummarize.pl
  28. +384 −0 bin/maint/captcha.pl
  29. +377 −0 bin/maint/clean_caches.pl
  30. +89 −0 bin/maint/generic.pl
  31. +566 −0 bin/maint/stats.pl
  32. +122 −0 bin/maint/statspics.pl
  33. +100 −0 bin/maint/synsuck.pl
  34. +26 −0 bin/maint/taskinfo.txt
  35. +1,095 −0 bin/moveucluster.pl
  36. +2,751 −0 bin/moveuclusterd.pl
  37. +258 −0 bin/qbufferd.pl
  38. +152 −0 bin/renameuser.pl
  39. +207 −0 bin/statserv.pl
  40. +33 −0 bin/truncate-cluster.pl
  41. +99 −0 bin/trunk-update.pl
  42. +1,054 −0 bin/upgrading/base-data.sql
  43. +72 −0 bin/upgrading/blobify_userpics.pl
  44. +77 −0 bin/upgrading/compress_cluster.pl
  45. +44 −0 bin/upgrading/copy-emailpass-out-of-user
  46. +41 −0 bin/upgrading/d1d2-single.pl
  47. +320 −0 bin/upgrading/d4d5-global.pl
  48. +349 −0 bin/upgrading/d5d6-mkf.pl
  49. +352 −0 bin/upgrading/d6d7-userpics.pl
  50. +76 −0 bin/upgrading/d7d8-polls.pl
  51. +592 −0 bin/upgrading/deadphrases.dat
  52. +2,487 −0 bin/upgrading/en.dat
  53. +48 −0 bin/upgrading/import-includes.pl
  54. +54 −0 bin/upgrading/make_system.pl
  55. +323 −0 bin/upgrading/migrate-phoneposts.pl
  56. +318 −0 bin/upgrading/migrate-userpics.pl
  57. +162 −0 bin/upgrading/migrate-userprop.pl
  58. +107 −0 bin/upgrading/moods.dat
  59. +886 −0 bin/upgrading/move0cluster.pl
  60. +84 −0 bin/upgrading/pop-clusterprops.pl
  61. +68 −0 bin/upgrading/pop-weekuu.pl
  62. +89 −0 bin/upgrading/populate-next-birthdays
  63. +1,331 −0 bin/upgrading/proplists.dat
  64. +85 −0 bin/upgrading/s1style-rw.pl
  65. +8,312 −0 bin/upgrading/s1styles.dat
  66. +83 −0 bin/upgrading/s2layers.dat
  67. BIN  bin/upgrading/s2layers/classic/classic.jpg
  68. +16 −0 bin/upgrading/s2layers/classic/en.s2
  69. +1,068 −0 bin/upgrading/s2layers/classic/layout.s2
  70. +424 −0 bin/upgrading/s2layers/classic/themes.s2
  71. BIN  bin/upgrading/s2layers/cleansimple/cleansimple.jpg
  72. +11 −0 bin/upgrading/s2layers/cleansimple/en.s2
  73. +1,201 −0 bin/upgrading/s2layers/cleansimple/layout.s2
  74. +425 −0 bin/upgrading/s2layers/cleansimple/themes.s2
  75. +2,809 −0 bin/upgrading/s2layers/core1.s2
  76. +1,301 −0 bin/upgrading/s2layers/deardiary/layout.s2
  77. BIN  bin/upgrading/s2layers/deardiary/preview.jpg
  78. +183 −0 bin/upgrading/s2layers/deardiary/themes.s2
  79. BIN  bin/upgrading/s2layers/digitalmultiplex/digitalmultiplex.jpg
  80. +10 −0 bin/upgrading/s2layers/digitalmultiplex/en.s2
  81. +1,506 −0 bin/upgrading/s2layers/digitalmultiplex/layout.s2
  82. +4 −0 bin/upgrading/s2layers/digitalmultiplex/themes.s2
  83. BIN  bin/upgrading/s2layers/disjointed/layout.jpg
  84. +1,873 −0 bin/upgrading/s2layers/disjointed/layout.s2
  85. +169 −0 bin/upgrading/s2layers/disjointed/themes.s2
  86. +17 −0 bin/upgrading/s2layers/generator/en.s2
  87. BIN  bin/upgrading/s2layers/generator/generator.jpg
  88. +1,459 −0 bin/upgrading/s2layers/generator/layout.s2
  89. +374 −0 bin/upgrading/s2layers/generator/themes.s2
  90. BIN  bin/upgrading/s2layers/haven/haven.png
Sorry, we could not display the entire diff because too many files (3,678) changed.
View
379 LICENSE
@@ -0,0 +1,379 @@
+This repository was originally based off of code retrieved from
+Six Apart's public "livejournal" svn repository. The original code
+carries this copyright:
+
+ The code in LiveJournal.org's "livejournal" cvs repository are
+ Copyright (C) 1994-2005 LiveJournal.com, Inc., a subsidiary of Six
+ Apart, Ltd.
+
+The code modifications made to the original code and that are
+contained in this repository carry the following copyright:
+
+ Original code copyright (C) 1994-2005 LiveJournal.com, Inc., a
+ subsidiary of Six Apart, Ltd. Modifications copyright (C)
+ 2008 by the Open Source Social Network Foundation, LLC.
+
+Additionally, some files were originally committed to this repository
+that were authored by the OSSNF. These files carry this copyright:
+
+ Copyright (C) 2008 by the Open Source Social Network Foundation, LLC.
+
+This program is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License
+as published by the Free Software Foundation; either version 2
+of the License, or (at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.
+
+The text of the GNU General Public License follows:
+
+-------
+
+ GNU GENERAL PUBLIC LICENSE
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The licenses for most software are designed to take away your
+freedom to share and change it. By contrast, the GNU General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+this service if you wish), that you receive source code or can get it
+if you want it, that you can change the software or use pieces of it
+in new free programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must show them these terms so they know their
+rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ Finally, any free program is threatened constantly by software
+patents. We wish to avoid the danger that redistributors of a free
+program will individually obtain patent licenses, in effect making the
+program proprietary. To prevent this, we have made it clear that any
+patent must be licensed for everyone's free use or not licensed at all.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains
+a notice placed by the copyright holder saying it may be distributed
+under the terms of this General Public License. The "Program", below,
+refers to any such program or work, and a "work based on the Program"
+means either the Program or any derivative work under copyright law:
+that is to say, a work containing the Program or a portion of it,
+either verbatim or with modifications and/or translated into another
+language. (Hereinafter, translation is included without limitation in
+the term "modification".) Each licensee is addressed as "you".
+
+Activities other than copying, distribution and modification are not
+covered by this License; they are outside its scope. The act of
+running the Program is not restricted, and the output from the Program
+is covered only if its contents constitute a work based on the
+Program (independent of having been made by running the Program).
+Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+source code as you receive it, in any medium, provided that you
+conspicuously and appropriately publish on each copy an appropriate
+copyright notice and disclaimer of warranty; keep intact all the
+notices that refer to this License and to the absence of any warranty;
+and give any other recipients of the Program a copy of this License
+along with the Program.
+
+You may charge a fee for the physical act of transferring a copy, and
+you may at your option offer warranty protection in exchange for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+of it, thus forming a work based on the Program, and copy and
+distribute such modifications or work under the terms of Section 1
+above, provided that you also meet all of these conditions:
+
+ a) You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b) You must cause any work that you distribute or publish, that in
+ whole or in part contains or is derived from the Program or any
+ part thereof, to be licensed as a whole at no charge to all third
+ parties under the terms of this License.
+
+ c) If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display an
+ announcement including an appropriate copyright notice and a
+ notice that there is no warranty (or else, saying that you provide
+ a warranty) and that users may redistribute the program under
+ these conditions, and telling the user how to view a copy of this
+ License. (Exception: if the Program itself is interactive but
+ does not normally print such an announcement, your work based on
+ the Program is not required to print an announcement.)
+
+These requirements apply to the modified work as a whole. If
+identifiable sections of that work are not derived from the Program,
+and can be reasonably considered independent and separate works in
+themselves, then this License, and its terms, do not apply to those
+sections when you distribute them as separate works. But when you
+distribute the same sections as part of a whole which is a work based
+on the Program, the distribution of the whole must be on the terms of
+this License, whose permissions for other licensees extend to the
+entire whole, and thus to each and every part regardless of who wrote it.
+
+Thus, it is not the intent of this section to claim rights or contest
+your rights to work written entirely by you; rather, the intent is to
+exercise the right to control the distribution of derivative or
+collective works based on the Program.
+
+In addition, mere aggregation of another work not based on the Program
+with the Program (or with a work based on the Program) on a volume of
+a storage or distribution medium does not bring the other work under
+the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+under Section 2) in object code or executable form under the terms of
+Sections 1 and 2 above provided that you also do one of the following:
+
+ a) Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of Sections
+ 1 and 2 above on a medium customarily used for software interchange; or,
+
+ b) Accompany it with a written offer, valid for at least three
+ years, to give any third party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a medium
+ customarily used for software interchange; or,
+
+ c) Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with such
+ an offer, in accord with Subsection b above.)
+
+The source code for a work means the preferred form of the work for
+making modifications to it. For an executable work, complete source
+code means all the source code for all modules it contains, plus any
+associated interface definition files, plus the scripts used to
+control compilation and installation of the executable. However, as a
+special exception, the source code distributed need not include
+anything that is normally distributed (in either source or binary
+form) with the major components (compiler, kernel, and so on) of the
+operating system on which the executable runs, unless that component
+itself accompanies the executable.
+
+If distribution of executable or object code is made by offering
+access to copy from a designated place, then offering equivalent
+access to copy the source code from the same place counts as
+distribution of the source code, even though third parties are not
+compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+except as expressly provided under this License. Any attempt
+otherwise to copy, modify, sublicense or distribute the Program is
+void, and will automatically terminate your rights under this License.
+However, parties who have received copies, or rights, from you under
+this License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+signed it. However, nothing else grants you permission to modify or
+distribute the Program or its derivative works. These actions are
+prohibited by law if you do not accept this License. Therefore, by
+modifying or distributing the Program (or any work based on the
+Program), you indicate your acceptance of this License to do so, and
+all its terms and conditions for copying, distributing or modifying
+the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the
+original licensor to copy, distribute or modify the Program subject to
+these terms and conditions. You may not impose any further
+restrictions on the recipients' exercise of the rights granted herein.
+You are not responsible for enforcing compliance by third parties to
+this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+infringement or for any other reason (not limited to patent issues),
+conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot
+distribute so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you
+may not distribute the Program at all. For example, if a patent
+license would not permit royalty-free redistribution of the Program by
+all those who receive copies directly or indirectly through you, then
+the only way you could satisfy both it and this License would be to
+refrain entirely from distribution of the Program.
+
+If any portion of this section is held invalid or unenforceable under
+any particular circumstance, the balance of the section is intended to
+apply and the section as a whole is intended to apply in other
+circumstances.
+
+It is not the purpose of this section to induce you to infringe any
+patents or other property right claims or to contest validity of any
+such claims; this section has the sole purpose of protecting the
+integrity of the free software distribution system, which is
+implemented by public license practices. Many people have made
+generous contributions to the wide range of software distributed
+through that system in reliance on consistent application of that
+system; it is up to the author/donor to decide if he or she is willing
+to distribute software through any other system and a licensee cannot
+impose that choice.
+
+This section is intended to make thoroughly clear what is believed to
+be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+certain countries either by patents or by copyrighted interfaces, the
+original copyright holder who places the Program under this License
+may add an explicit geographical distribution limitation excluding
+those countries, so that distribution is permitted only in or among
+countries not thus excluded. In such case, this License incorporates
+the limitation as if written in the body of this License.
+
+ 9. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of this License which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+this License, you may choose any version ever published by the Free Software
+Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+convey the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) <year> <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) year name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, the commands you use may
+be called something other than `show w' and `show c'; they could even be
+mouse-clicks or menu items--whatever suits your program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program into
+proprietary programs. If your program is a subroutine library, you may
+consider it more useful to permit linking proprietary applications with the
+library. If this is what you want to do, use the GNU Library General
+Public License instead of this License.
View
15 README
@@ -1,3 +1,14 @@
-This is a temporary file, just holding open the directory.
+Please see the LICENSE file for the license of this code. Note that all code
+committed to this repository MUST be licensed under the GPL and have proper
+copyright notices tagged at the top of the file.
-Edit, edit, and more!
+For more information on how to use this software, please harass someone to
+actually write out documentation here. :-)
+
+If you just want to get started with a fresh installation, you can get things
+rolling along:
+
+ perl bin/bootstra.pl
+
+This will check out the various repositories that we use and put them in the
+appropriate place.
View
29 bin/bootstrap.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use strict;
+
+# check for svn in a known place
+die "Expected svn in /usr/bin ... not found!\n"
+ unless -e '/usr/bin/svn';
+
+# get the right directory
+my $LJHOME = $ENV{'LJHOME'};
+die "Must set the \$LJHOME environment variable before running this.\n"
+ unless -d $LJHOME;
+chdir( $LJHOME )
+ or die "Couldn't chdir to \$LJHOME directory.\n";
+
+# more than likely we don't have vcv, so let's get it
+die "Did you already bootstrap? cvs/vcv exists.\n"
+ if -d "$LJHOME/cvs/vcv";
+
+# so now get it
+system( '/usr/bin/svn co http://code.sixapart.com/svn/vcv/trunk/ cvs/vcv' );
+die "Unable to checkout vcv from Six Apart SVN repository.\n"
+ unless -d "$LJHOME/cvs/vcv" && -e "$LJHOME/cvs/vcv/bin/vcv";
+
+# now get vcv to do the rest for us
+system( 'cvs/vcv/bin/vcv --conf=cvs/multicvs.conf --checkout' );
+
+# finished :-)
+print "Done! We hope. :-)\n";
View
15 bin/build-usersearch
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+use strict;
+use lib "$ENV{LJHOME}/cgi-bin";
+use Carp;
+BEGIN {
+ require 'ljlib.pl';
+}
+use LJ::UserSearch::MetaUpdater;
+
+my $filename = shift || "$ENV{LJHOME}/var/usersearch.data";
+
+$SIG{__DIE__} = sub { Carp::croak( @_ ) };
+
+LJ::UserSearch::MetaUpdater::update_file($filename);
+
View
279 bin/checkconfig.pl
@@ -0,0 +1,279 @@
+#!/usr/bin/perl
+#
+
+use strict;
+use Getopt::Long;
+
+my $debs_only = 0;
+my ($only_check, $no_check, $opt_nolocal);
+
+my %dochecks; # these are the ones we'll actually do
+my @checks = ( # put these in the order they should be checked in
+ "modules",
+ "env",
+ "database",
+ "ljconfig",
+);
+foreach my $check (@checks) { $dochecks{$check} = 1; }
+
+sub usage {
+ die "Usage: checkconfig.pl
+checkconfig.pl --needed-debs
+checkconfig.pl --only=<check> | --no=<check>
+
+Checks are:
+ " . join(', ', @checks);
+}
+
+usage() unless GetOptions(
+ 'needed-debs' => \$debs_only,
+ 'only=s' => \$only_check,
+ 'no=s' => \$no_check,
+ 'nolocal' => \$opt_nolocal,
+ );
+
+if ($debs_only) {
+ $dochecks{ljconfig} = 0;
+ $dochecks{database} = 0;
+}
+
+usage() if $only_check && $no_check;
+
+%dochecks = ( $only_check => 1)
+ if $only_check;
+
+# dependencies
+if ($dochecks{ljconfig}) {
+ $dochecks{env} = 1;
+}
+
+$dochecks{$no_check} = 0
+ if $no_check;
+
+my @errors;
+my $err = sub {
+ return unless @_;
+ die "\nProblem:\n" . join('', map { " * $_\n" } @_);
+};
+
+my %modules = (
+ "DateTime" => { 'deb' => 'libdatetime-perl' },
+ "DBI" => { 'deb' => 'libdbi-perl', },
+ "DBD::mysql" => { 'deb' => 'libdbd-mysql-perl', },
+ "Class::Autouse" => { 'deb' => 'libclass-autouse-perl', },
+ "Digest::MD5" => { 'deb' => 'libmd5-perl', },
+ "Digest::SHA1" => { 'deb' => 'libdigest-sha1-perl', },
+ "HTML::Template" => { 'deb' => 'libhtml-template-perl' },
+ "Image::Size" => { 'deb' => 'libimage-size-perl', },
+ "MIME::Lite" => { 'deb' => 'libmime-lite-perl', },
+ "MIME::Words" => { 'deb' => 'libmime-perl', },
+ "Compress::Zlib" => { 'deb' => 'libcompress-zlib-perl', },
+ "Net::DNS" => {
+ 'deb' => 'libnet-dns-perl',
+ },
+ "URI::URL" => { 'deb' => 'liburi-perl' },
+ "HTML::Tagset" => { 'deb' => 'libhtml-tagset-perl' },
+ "HTML::Parser" => { 'deb' => 'libhtml-parser-perl', },
+ "LWP::Simple" => { 'deb' => 'libwww-perl', },
+ "LWP::UserAgent" => { 'deb' => 'libwww-perl', },
+ "GD" => { 'deb' => 'libgd-gd2-perl' },
+ "GD::Graph" => {
+ 'deb' => 'libgd-graph-perl',
+ 'opt' => 'Required for making graphs for the statistics page.',
+ },
+ "Mail::Address" => { 'deb' => 'libmailtools-perl', },
+ "Proc::ProcessTable" => {
+ 'deb' => 'libproc-process-perl',
+ 'opt' => "Better reliability for starting daemons necessary for high-traffic installations.",
+ },
+ "RPC::XML" => {
+ 'deb' => 'librpc-xml-perl',
+ 'opt' => 'Required for outgoing XML-RPC support',
+ },
+ "SOAP::Lite" => {
+ 'deb' => 'libsoap-lite-perl',
+ 'opt' => 'Required for XML-RPC support.',
+ },
+ "Unicode::MapUTF8" => { 'deb' => 'libunicode-maputf8-perl', },
+ "XML::RSS" => {
+ 'deb' => 'libxml-rss-perl',
+ 'opt' => 'Required for retrieving RSS off of other sites (syndication).',
+ },
+ "XML::Simple" => {
+ 'deb' => 'libxml-simple-perl',
+ 'ver' => 2.12,
+ },
+ "String::CRC32" => {
+ 'deb' => 'libstring-crc32-perl',
+ 'opt' => 'Required for palette-altering of PNG files. Only necessary if you plan to make your own S2 styles that use PNGs, not GIFs.',
+ },
+ "IO::WrapTie" => { 'deb' => 'libio-stringy-perl' },
+ "XML::Atom" => {
+ 'deb' => 'libxml-atom-perl',
+ 'opt' => 'Required for Atom API support.',
+ },
+ "Math::BigInt::GMP" => {
+ 'deb' => 'libmath-bigint-gmp-perl',
+ 'opt' => 'Aides Crypt::DH so it is not crazy slow.',
+ },
+ "URI::Fetch" => {
+ 'deb' => 'liburi-fetch-perl',
+ 'opt' => 'Required for OpenID support.',
+ },
+ "Crypt::DH" => {
+ 'deb' => 'libcrypt-dh-perl',
+ 'opt' => 'Required for OpenID support.',
+ },
+ "Unicode::CheckUTF8" => {},
+ "Digest::HMAC_SHA1" => {
+ 'deb' => 'libdigest-hmac-perl',
+ },
+ "Image::Magick" => {
+ 'deb' => 'perlmagick',
+ 'opt' => "Required for the userpic factory.",
+ },
+ "Class::Accessor" => {
+ 'deb' => 'libclass-accessor-perl',
+ 'opt' => "Required for TheSchwartz job submission.",
+ },
+ "Class::Trigger" => {
+ 'deb' => 'libclass-trigger-perl',
+ 'opt' => "Required for TheSchwartz job submission.",
+ },
+ "Class::Data::Inheritable" => {
+ 'deb' => 'libclass-data-inheritable-perl',
+ 'opt' => "Required for TheSchwartz job submission.",
+ },
+ "GnuPG::Interface" => {
+ 'deb' => 'libgnupg-interface-perl',
+ 'opt' => "Required for email posting.",
+ },
+ "Mail::GnuPG" => {
+ 'deb' => 'libmail-gnupg-perl',
+ 'opt' => "Required for email posting.",
+ },
+ "Text::vCard" => {
+ 'deb' => 'libtext-vcard-perl',
+ 'opt' => "Used to generate user vCards.",
+ },
+ "IP::Country::Fast" => {
+ 'opt' => "Required for country lookup with IP address.",
+ },
+ "GTop" => {
+ 'opt' => "Required for Apache per-request database logging.",
+ },
+ );
+
+sub check_modules {
+ print "[Checking for Perl Modules....]\n"
+ unless $debs_only;
+
+ my @debs;
+
+ foreach my $mod (sort keys %modules) {
+ my $rv = eval "use $mod;";
+ if ($@) {
+ my $dt = $modules{$mod};
+ unless ($debs_only) {
+ if ($dt->{'opt'}) {
+ print STDERR "Missing optional module $mod: $dt->{'opt'}\n";
+ } else {
+ push @errors, "Missing perl module: $mod";
+ }
+ }
+ push @debs, $dt->{'deb'} if $dt->{'deb'};
+ next;
+ }
+
+ my $ver_want = $modules{$mod}{ver};
+ my $ver_got = $mod->VERSION;
+ if ($ver_want && $ver_got && $ver_got < $ver_want) {
+ push @errors, "Out of date module: $mod (need $ver_want, $ver_got installed)";
+ }
+ }
+ if (@debs && -e '/etc/debian_version') {
+ if ($debs_only) {
+ print join(' ', @debs);
+ } else {
+ print STDERR "\n# apt-get install ", join(' ', @debs), "\n\n";
+ }
+ }
+
+ $err->(@errors);
+}
+
+sub check_env {
+ print "[Checking LJ Environment...]\n"
+ unless $debs_only;
+
+ $err->("\$LJHOME environment variable not set.")
+ unless $ENV{'LJHOME'};
+ $err->("\$LJHOME directory doesn't exist ($ENV{'LJHOME'})")
+ unless -d $ENV{'LJHOME'};
+
+ # before ljconfig.pl is called, we want to call the site-local checkconfig,
+ # otherwise ljconfig.pl might load ljconfig-local.pl, which maybe load
+ # new modules to implement site-specific hooks.
+ my $local_config = "$ENV{'LJHOME'}/bin/checkconfig-local.pl";
+ $local_config .= ' --needed-debs' if $debs_only;
+ if (!$opt_nolocal && -e $local_config) {
+ my $good = eval { require $local_config; };
+ exit 1 unless $good;
+ }
+
+ $err->("No ljconfig.pl file found at $ENV{'LJHOME'}/etc/ljconfig.pl")
+ unless -e "$ENV{'LJHOME'}/etc/ljconfig.pl";
+
+ eval { require "$ENV{'LJHOME'}/cgi-bin/ljlib.pl"; };
+ $err->("Failed to load ljlib.pl: $@") if $@;
+
+}
+
+sub check_database {
+
+ require "$ENV{'LJHOME'}/cgi-bin/ljlib.pl";
+ my $dbh = LJ::get_dbh("master");
+ unless ($dbh) {
+ $err->("Couldn't get master database handle.");
+ }
+ foreach my $c (@LJ::CLUSTERS) {
+ my $dbc = LJ::get_cluster_master($c);
+ next if $dbc;
+ $err->("Couldn't get db handle for cluster \#$c");
+ }
+
+ if (%LJ::MOGILEFS_CONFIG && $LJ::MOGILEFS_CONFIG{hosts}) {
+ print "[Checking MogileFS client.]\n";
+ my $mog = LJ::mogclient();
+ die "Couldn't create MogileFS client." unless $mog;
+ }
+}
+
+sub check_ljconfig {
+ # if we're a developer running this, make sure we didn't add any
+ # new configuration directives without first documenting them:
+ $ENV{READ_LJ_SOURCE} = 1 if $LJ::IS_DEV_SERVER;
+
+ # check for beta features cap
+ unless (LJ::class_bit(LJ::BetaFeatures->cap_name)) {
+ print STDERR "Warning: BetaFeatures module cannot be used unless '" . LJ::BetaFeatures->cap_name . "' cap is configured.";
+ }
+
+ require LJ::ConfCheck;
+ my @errs = LJ::ConfCheck::config_errors();
+ local $" = ",\n\t";
+ $err->("Config errors: @errs") if @errs;
+}
+
+foreach my $check (@checks) {
+ next unless $dochecks{$check};
+ my $cn = "check_".$check;
+ no strict 'refs';
+ &$cn;
+}
+
+unless ($debs_only) {
+ print "All good.\n";
+ print "NOTE: checkconfig.pl doesn't check everything yet\n";
+}
+
View
38 bin/cvsreport.pl
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+#
+# This is now just a wrapper around the non-LJ-specific multicvs.pl
+#
+
+use strict;
+
+unless (-d $ENV{'LJHOME'}) {
+ die "\$LJHOME not set.\n";
+}
+
+if (defined $ENV{'FBHOME'} && $ENV{'PWD'} =~ /^$ENV{'FBHOME'}/i) {
+ die "You are running this LJ script while working in FBHOME" unless $ENV{FBHOME} eq $ENV{LJHOME};
+}
+
+# be paranoid in production, force --these
+my @paranoia;
+eval { require "$ENV{LJHOME}/etc/ljconfig.pl"; };
+if ($LJ::IS_LJCOM_PRODUCTION || $LJ::IS_LJCOM_BETA) {
+ @paranoia = ('--these');
+}
+
+# strip off paths beginning with LJHOME
+# (useful if you tab-complete filenames)
+$_ =~ s!\Q$ENV{'LJHOME'}\E/?!! foreach (@ARGV);
+
+my @extra;
+my $vcv_exe = "multicvs.pl";
+if (-e "$ENV{LJHOME}/bin/vcv") {
+ $vcv_exe = "vcv";
+ @extra = ("--headserver=code.sixapart.com:10000");
+}
+
+exec("$ENV{'LJHOME'}/bin/$vcv_exe",
+ "--conf=$ENV{'LJHOME'}/cvs/multicvs.conf",
+ @extra,
+ @paranoia,
+ @ARGV);
View
369 bin/dbcheck.pl
@@ -0,0 +1,369 @@
+#!/usr/bin/perl
+#
+
+use strict;
+use DBI;
+use Getopt::Long;
+
+my $help = 0;
+my $opt_fh = 0;
+my $opt_fix = 0;
+my $opt_start = 0;
+my $opt_stop = 0;
+my $opt_err = 0;
+my $opt_all = 0;
+my $opt_tablestatus;
+my $opt_checkreport = 0;
+my $opt_verbose;
+my $opt_rates;
+my @opt_run;
+exit 1 unless GetOptions('help' => \$help,
+ 'flushhosts' => \$opt_fh,
+ 'start' => \$opt_start,
+ 'stop' => \$opt_stop,
+ 'checkreport' => \$opt_checkreport,
+ 'rates' => \$opt_rates,
+ 'fix' => \$opt_fix,
+ 'run=s' => \@opt_run,
+ 'onlyerrors' => \$opt_err,
+ 'all' => \$opt_all,
+ 'tablestatus' => \$opt_tablestatus,
+ 'verbose' => \$opt_verbose,
+ );
+
+unless (-d $ENV{'LJHOME'}) {
+ die "\$LJHOME not set.\n";
+}
+
+if ($help) {
+ die ("Usage: dbcheck.pl [opts] [[cmd] args...]\n" .
+ " --all Check all hosts, even those with no weight assigned.\n" .
+ " --help Get this help\n" .
+ " --flushhosts Send 'FLUSH HOSTS' to each db as root.\n".
+ " --fix Fix (once) common problems.\n".
+ " --checkreport Show tables that haven't been checked in a while.\n".
+ " --stop Stop replication.\n".
+ " --start Start replication.\n".
+ " --run <sql> Run arbitrary SQL.\n".
+ " --onlyerrors Will be silent unless there are errors.\n".
+ " --tablestatus Show warnings about full/sparse tables.\n".
+ "\n".
+ "Commands\n".
+ " (none) Shows replication status.\n".
+ " queries <host> Shows active queries on host, sorted by running time.\n"
+ );
+}
+
+require "$ENV{'LJHOME'}/cgi-bin/ljdb.pl";
+
+debug("Connecting to master...");
+my $dbh = LJ::DB::dbh_by_role("master");
+die "Can't get master db handle\n" unless $dbh;
+
+my %dbinfo; # dbid -> hashref
+my %name2id; # name -> dbid
+my $sth;
+my $masterid = 0;
+
+my %subclust; # id -> name of parent (pork-85 -> "pork")
+
+$sth = $dbh->prepare("SELECT dbid, name, masterid, rootfdsn FROM dbinfo");
+$sth->execute;
+while ($_ = $sth->fetchrow_hashref) {
+ if ($_->{name} =~ /(.+)\-\d\d$/) {
+ $subclust{$_->{dbid}} = $1;
+ next;
+ }
+ next unless $_->{'dbid'};
+ $dbinfo{$_->{'dbid'}} = $_;
+ $name2id{$_->{'name'}} = $_->{'dbid'};
+}
+
+my %role; # rolename -> dbid -> [ norm, curr ]
+my %rolebyid; # dbid -> rolename -> [ norm, curr ]
+$sth = $dbh->prepare("SELECT dbid, role, norm, curr FROM dbweights");
+$sth->execute;
+while ($_ = $sth->fetchrow_hashref) {
+ my $id = $_->{dbid};
+ if ($subclust{$id}) {
+ $id = $name2id{$subclust{$id}};
+ }
+ next unless defined $dbinfo{$id};
+ $dbinfo{$id}->{'totalweight'} += $_->{'curr'};
+ $role{$_->{role}}->{$id} = [ $_->{norm}, $_->{curr} ];
+ $rolebyid{$id}->{$_->{role}} = [ $_->{norm}, $_->{curr} ];
+}
+
+check_report() if $opt_checkreport;
+rate_report() if $opt_rates;
+
+my %root_handle; # name -> $db
+my $root_handle = sub {
+ my $name = shift;
+ return $root_handle{$name} if exists $root_handle{$name};
+ debug("Connecting to '$name' ...");
+ $LJ::DB_TIMEOUT = 1;
+ my $db = LJ::DB::root_dbh_by_name($name);
+ debug(" ($name: failed to connect)") unless $db;
+ return $root_handle{$name} = $db;
+};
+
+my @errors;
+my %master_status; # dbid -> [ $file, $pos ]
+
+my $check_master_status = sub {
+ my $dbid = shift;
+ my $d = $dbinfo{$dbid};
+ die "Bogus DB: $dbid" unless $d;
+ my $db = $root_handle->($d->{name});
+ next unless $db;
+
+ my ($masterfile, $masterpos) = $db->selectrow_array("SHOW MASTER STATUS");
+ $master_status{$dbid} = [ $masterfile, $masterpos ];
+};
+
+my $check = sub {
+ my $dbid = shift;
+ my $d = $dbinfo{$dbid};
+ die "Bogus DB: $dbid" unless $d;
+
+ # calculate roles to show
+ my $roles;
+ {
+ my %drole; # display role -> 1
+ foreach my $role (grep { $role{$_}{$dbid}[1] } keys %{$rolebyid{$dbid}}) {
+ my $drole = $role;
+ $drole =~ s/cluster(\d+)\d/cluster${1}0/;
+ $drole{$drole} = 1;
+ }
+ $roles = join(", ", sort keys %drole);
+ }
+
+ my $db = $root_handle->($d->{name});
+ unless ($db) {
+ printf("%4d %-18s %4s %16s %14s ($roles)\n",
+ $dbid,
+ $d->{name},
+ $d->{masterid} ? $d->{masterid} : "",
+ ) unless $opt_err;
+ push @errors, "Can't connect to $d->{'name'}";
+ return 0;
+ }
+
+ my $tzone;
+ (undef, $tzone) = $db->selectrow_array("show variables like 'timezone'");
+ $tzone ||= "???";
+
+ $sth = $db->prepare("SHOW PROCESSLIST");
+ $sth->execute;
+ my $pcount_total = 0;
+ my $pcount_busy = 0;
+ while (my $r = $sth->fetchrow_hashref) {
+ next if $r->{'State'} =~ /waiting for/i;
+ next if $r->{'State'} eq "Reading master update";
+ next if $r->{'State'} =~ /^(Has (sent|read) all)|(Sending binlog)/;
+ $pcount_total++;
+ $pcount_busy++ if $r->{'State'};
+ }
+
+ my @master_logs;
+ my $log_count = 0;
+ if ($master_status{$dbid} && $master_status{$dbid}->[1]) {
+ $sth = $db->prepare("SHOW MASTER LOGS");
+ $sth->execute;
+ while (my ($log) = $sth->fetchrow_array) {
+ push @master_logs, $log;
+ $log_count++;
+ }
+ }
+
+ my $ss = $db->selectrow_hashref("show slave status");
+ if ($ss) {
+ foreach my $k (sort keys %$ss) {
+ $ss->{lc $k} = $ss->{$k};
+ }
+ }
+
+ my $diff;
+ if ($ss) {
+ if ($ss->{'slave_io_running'} eq "Yes" && $ss->{'slave_sql_running'} eq "Yes") {
+ if ($ss->{'master_log_file'} eq $ss->{'relay_master_log_file'}) {
+ $diff = $ss->{'read_master_log_pos'} - $ss->{'exec_master_log_pos'};
+ } else {
+ $diff = "XXXXXXX";
+ push @errors, "Wrong log file: $d->{name}";
+ }
+ } else {
+ $diff = "XXXXXXX";
+ $ss->{last_error} =~ s/[^\n\r\t\x20-\x7e]//g;
+ push @errors, "Slave not running: $d->{name}: $ss->{last_error}";
+ }
+
+ my $ms = $master_status{$d->{masterid}} || [];
+ #print " master: [@$ms], slave at: [$ss->{master_log_file}, $ss->{read_master_log_pos}]\n";
+ if ($ss->{master_log_file} ne $ms->[0] || $ss->{read_master_log_pos} < $ms->[1] - 20_000) {
+ push @errors, "$d->{name}: Relay log behind: master=[@$ms], $d->{name}=[$ss->{master_log_file}, $ss->{read_master_log_pos}]";
+ }
+
+ } else {
+ $diff = "-"; # not applicable
+ }
+
+ my $extra_version = "";
+ my $ver = $db->selectrow_array('SELECT VERSION()');
+ if ($ver) {
+ $ver =~ s/^(\d\.\d+\.\d+).*$/$1/;
+ $extra_version = $ver;
+ } else {
+ $extra_version = "unknown";
+ }
+
+ #print "$dbid of $d->{masterid}: $d->{name} ($roles)\n";
+ printf("%4d %-18s %4s repl:%7s %4s conn:%4d/%4d $tzone \%s ($roles)\n",
+ $dbid,
+ $d->{name},
+ $d->{masterid} ? $d->{masterid} : "",
+ $diff,
+ $log_count ? sprintf("<%2s>", $log_count) : "",
+ $pcount_busy, $pcount_total,
+ $extra_version) unless $opt_err;
+};
+
+$check_master_status->($_) foreach (sorted_dbids());
+
+$check->($_) foreach (sorted_dbids());
+
+if (@errors) {
+ if ($opt_err) {
+ my %ignore;
+ open(EX, "$ENV{'HOME'}/.dbcheck.ignore");
+ while (<EX>) {
+ s/\s+$//;
+ $ignore{$_} = 1;
+ }
+ close EX;
+ @errors = grep { ! $ignore{$_} } @errors;
+ }
+ print STDERR "\nERRORS:\n" if @errors;
+ foreach (@errors) {
+ print STDERR " * $_\n";
+ }
+}
+
+my $sorted_cache;
+sub sorted_dbids {
+ return @$sorted_cache if $sorted_cache;
+ $sorted_cache = [ _sorted_dbids() ];
+ return @$sorted_cache;
+}
+
+sub _sorted_dbids {
+ my @ids;
+ my %added; # dbid -> 1
+
+ my $add = sub {
+ my $dbid = shift;
+ $added{$dbid} = 1;
+ push @ids, $dbid;
+ };
+
+ my $masterid = (keys %{$role{'master'}})[0];
+ $add->($masterid);
+
+ # then slaves
+ foreach my $id (sort { $dbinfo{$a}->{name} cmp $dbinfo{$b}->{name} }
+ grep { ! $added{$_} && $rolebyid{$_}->{slave} } keys %dbinfo) {
+ $add->($id);
+ }
+
+ # now, figure out which remaining are associated with cluster roles (user clusters)
+ my %minclust; # dbid -> minimum cluster number associated
+ my %is_master; # dbid -> bool (is cluster master)
+ foreach my $dbid (grep { ! $added{$_} } keys %dbinfo) {
+ foreach my $role (keys %{ $rolebyid{$dbid} || {} }) {
+ next unless $role =~ /^cluster(\d+)(.*)/;
+ $minclust{$dbid} = $1 if ! $minclust{$dbid} || $1 < $minclust{$dbid};
+ $is_master{$dbid} ||= $2 eq "" || $2 eq "a" || $2 eq "b";
+ }
+ }
+
+ # then misc
+ foreach my $id (sort { $dbinfo{$a}->{name} cmp $dbinfo{$b}->{name} }
+ grep { ! $added{$_} && ! $minclust{$_} } keys %dbinfo) {
+ $add->($id);
+ }
+
+
+ # then clusters, in order
+ foreach my $id (sort { $minclust{$a} <=> $minclust{$b} ||
+ $is_master{$b} <=> $is_master{$a} }
+ grep { ! $added{$_} && $minclust{$_} } keys %dbinfo) {
+ $add->($id);
+ }
+ return @ids;
+}
+
+sub check_report {
+ foreach my $dbid (sort { $dbinfo{$a}->{name} cmp $dbinfo{$b}->{name} }
+ keys %dbinfo) {
+ my $d = $dbinfo{$dbid};
+ die "Bogus DB: $dbid" unless $d;
+ my $db = $root_handle->($d->{name});
+
+ unless ($db) {
+ print "$d->{name}\t?\t?\t?\n";
+ next;
+ }
+
+ my $dbs = $db->selectcol_arrayref("SHOW DATABASES");
+ foreach my $dbname (@$dbs) {
+ $db->do("USE $dbname");
+ my $ts = $db->selectall_hashref("SHOW TABLE STATUS", "Name");
+ foreach my $tn (sort keys %$ts) {
+ my $v = $ts->{$tn};
+ my $ut = $v->{Check_time} || "0000-00-00 00:00:00";
+ $ut =~ s/ /,/;
+ print "$d->{name}\t$dbname\t$tn\t$ut\t$v->{Type}-$v->{Row_format}\t$v->{Rows}\n";
+ }
+
+ }
+ }
+ exit 0;
+}
+
+use Time::HiRes ();
+
+sub rate_report {
+ my %prev; # dbid -> [ time, questions ]
+
+ while (1) {
+ print "\n";
+ my $sum = 0;
+ foreach my $dbid (sorted_dbids()) {
+ my $d = $dbinfo{$dbid};
+ die "Bogus DB: $dbid" unless $d;
+ my $db = $root_handle->($d->{name});
+
+ next unless $db;
+ my (undef, $qs) = $db->selectrow_array("SHOW STATUS LIKE 'Questions'");
+ my $now = Time::HiRes::time();
+ my $cur = [ $now, $qs ];
+ if (my $old = $prev{$dbid}) {
+ my $dt = $now - $old->[0];
+ my $qnew = $qs - $old->[1];
+ my $rate = ($qnew / $dt);
+ $sum += $rate;
+ printf "%20s: %7.01f q/s\n", $d->{name}, $rate;
+ }
+ $prev{$dbid} ||= $cur;
+ }
+ printf "%20s: %7.01f q/s\n", "SUM", $sum;
+
+ sleep 1;
+ }
+}
+
+sub debug {
+ return unless $opt_verbose;
+ warn $_[0], "\n";
+}
View
157 bin/deleteusers.pl
@@ -0,0 +1,157 @@
+#!/usr/bin/perl
+#
+
+use strict;
+
+require "$ENV{'LJHOME'}/cgi-bin/ljlib.pl";
+my $dbh = LJ::get_dbh("master");
+$dbh->{'RaiseError'} = 1;
+$dbh->{'PrintError'} = 1;
+my $sth;
+
+$sth = $dbh->prepare("SELECT userid FROM user WHERE statusvis='D' AND statusvisdate < DATE_SUB(NOW(), INTERVAL 60 DAY) LIMIT 1000");
+$sth->execute;
+my @delusers;
+while (my $duid = $sth->fetchrow_array) {
+ push @delusers, $duid;
+}
+print "Users to delete: ", scalar(@delusers), "\n";
+
+# Get hashref mapping {userid => $u} for all users to be deleted
+my $user = LJ::load_userids(@delusers);
+
+LJ::load_props($dbh, "talk");
+my $p_delposter = LJ::get_prop("talk", "deleted_poster");
+die "No 'deleted_poster' talkprop?" unless $p_delposter;
+my $ids;
+
+my $lastbreak = time();
+my $pause = sub {
+ if (time() - $lastbreak > 3) { print "pause.\n"; sleep(1); $lastbreak = time(); }
+};
+
+# FIXME: This will soon need to be changed to use methods of the $u
+# object rather than global LJ:: functions, but this should work
+# for now.
+
+my $runsql = sub {
+ my $db = $dbh;
+ if (ref $_[0]) { $db = shift; }
+ my $user = shift;
+ my $sql = shift;
+ print " ($user) $sql\n";
+ $db->do($sql);
+};
+
+my $czero = 0;
+
+foreach my $uid (@delusers)
+{
+ my $du = $user->{$uid};
+ my $user = $du->{'user'};
+ print "$du->{'user'} ($du->{'userid'}) @ $du->{'statusvisdate'}";
+ if ($du->{clusterid} == 0) {
+ print " (on clusterid 0; skipping)\n";
+ $czero++;
+ next;
+ }
+ print " (cluster $du->{'clusterid'})...\n";
+ $pause->();
+
+ # get a db handle for the cluster master.
+ LJ::start_request(); # might've been awhile working with last handle, we don't want to be given an expired one.
+ my $dbcm = LJ::get_cluster_master($du);
+ $dbcm->{'RaiseError'} = 1;
+ $dbcm->{'PrintError'} = 1;
+
+ # make all the user's comments posted now be owned by posterid 0 (anonymous)
+ # but with meta-data saying who used to own it
+ # ..... hm, with clusters this is a pain. let's not.
+
+ # delete memories
+ print " memories\n";
+ while (($ids = $dbh->selectcol_arrayref("SELECT memid FROM memorable WHERE userid=$uid LIMIT 100")) && @{$ids})
+ {
+ my $in = join(",", @$ids);
+ print " id: $in\n";
+ $runsql->($dbh, $user, "DELETE FROM memkeyword WHERE memid IN ($in)");
+ $runsql->($dbh, $user, "DELETE FROM memorable WHERE memid IN ($in)");
+ }
+
+ # delete todos
+ print " todos\n";
+ while (($ids = $dbh->selectcol_arrayref("SELECT todoid FROM todo WHERE journalid=$uid LIMIT 100")) && @{$ids})
+ {
+ my $in = join(",", @$ids);
+ print " id: $in\n";
+ $runsql->($dbh, $user, "DELETE FROM tododep WHERE todoid IN ($in)");
+ $runsql->($dbh, $user, "DELETE FROM todokeyword WHERE todoid IN ($in)");
+ $runsql->($dbh, $user, "DELETE FROM todo WHERE todoid IN ($in)");
+ }
+
+ # delete userpics
+ {
+ print " userpics\n";
+ if ($du->{'dversion'} > 6) {
+ $ids = $dbcm->selectcol_arrayref("SELECT picid FROM userpic2 WHERE userid=$uid");
+ } else {
+ $ids = $dbh->selectcol_arrayref("SELECT picid FROM userpic WHERE userid=$uid");
+ }
+ my $in = join(",",@$ids);
+ if ($in) {
+ print " userpics: $in\n";
+ $runsql->($dbcm, $user, "DELETE FROM userpicblob2 WHERE userid=$uid AND picid IN ($in)");
+ if ($du->{'dversion'} > 6) {
+ $runsql->($dbcm, $user, "DELETE FROM userpic2 WHERE userid=$uid");
+ $runsql->($dbcm, $user, "DELETE FROM userpicmap2 WHERE userid=$uid");
+ $runsql->($dbcm, $user, "DELETE FROM userkeywords WHERE userid=$uid");
+ } else {
+ $runsql->($dbh, $user, "DELETE FROM userpic WHERE userid=$uid");
+ $runsql->($dbh, $user, "DELETE FROM userpicmap WHERE userid=$uid");
+ }
+ }
+ }
+
+ # delete posts
+ print " posts\n";
+ while (($ids = $dbcm->selectall_arrayref("SELECT jitemid, anum FROM log2 WHERE journalid=$uid LIMIT 100")) && @{$ids})
+ {
+ foreach my $idanum (@$ids) {
+ my ($id, $anum) = ($idanum->[0], $idanum->[1]);
+ print " deleting $id (a=$anum) ($uid; $du->{'user'})\n";
+ LJ::delete_entry($du, $id, 0, $anum);
+ $pause->();
+ }
+ }
+
+ # misc:
+ $runsql->($user, "DELETE FROM userusage WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM friends WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM friends WHERE friendid=$uid");
+ $runsql->($user, "DELETE FROM friendgroup WHERE userid=$uid");
+ $runsql->($dbcm, $user, "DELETE FROM friendgroup2 WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM memorable WHERE userid=$uid");
+ $runsql->($dbcm, $user, "DELETE FROM memorable2 WHERE userid=$uid");
+ $runsql->($dbcm, $user, "DELETE FROM userkeywords WHERE userid=$uid");
+ $runsql->($dbcm, $user, "DELETE FROM memkeyword2 WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM userbio WHERE userid=$uid");
+ $runsql->($dbcm, $user, "DELETE FROM userbio WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM userinterests WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM userprop WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM userproplite WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM txtmsg WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM overrides WHERE user='$du->{'user'}'");
+ $runsql->($user, "DELETE FROM priv_map WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM infohistory WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM reluser WHERE userid=$uid");
+ $runsql->($user, "DELETE FROM reluser WHERE targetid=$uid");
+ $runsql->($user, "DELETE FROM userlog WHERE userid=$uid");
+
+ $runsql->($user, "UPDATE user SET statusvis='X', statusvisdate=NOW(), password='' WHERE userid=$uid");
+
+}
+
+if ($czero) {
+ print "\nWARNING: There are $czero users on cluster zero pending deletion.\n";
+ print " These users must be upgraded before they can be expunged with this tool.\n";
+}
View
27 bin/dev/entrydump.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+#
+
+use strict;
+use lib "$ENV{LJHOME}/cgi-bin";
+require 'ljlib.pl';
+use LJ::Entry;
+
+my $url = shift;
+
+LJ::no_cache(sub {
+
+my $entry = LJ::Entry->new_from_url($url);
+
+print "entry = $entry\n";
+use Data::Dumper;
+
+ print Dumper($entry->props, clean($entry->event_orig), clean($entry->event_raw));
+});
+
+
+sub clean {
+ my $txt = shift;
+ $txt =~ s/[^\x20-\x7f]/"[" . sprintf("%02x", ord($&)) . "]"/eg;
+ return $txt;
+}
+
View
27 bin/dev/inject_sms.pl
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use lib "$ENV{LJHOME}/cgi-bin";
+
+use LJ::SMS::Message;
+
+require "ljlib.pl";
+
+my ($user, $msg) = @ARGV[0,1];
+
+my $u = LJ::load_user($user);
+
+my $ljmsg = LJ::SMS::Message->new
+ ( owner => $u,
+ from => $u,
+ type => 'incoming',
+ body_text => $msg,
+ );
+
+warn LJ::D($ljmsg);
+
+warn "Enqueue\n";
+LJ::SMS->enqueue_as_incoming($ljmsg);
+
+
+
View
217 bin/dumpsql.pl
@@ -0,0 +1,217 @@
+#!/usr/bin/perl
+#
+# <LJDEP>
+# lib: cgi-bin/ljlib.pl
+# </LJDEP>
+
+use strict;
+require "$ENV{'LJHOME'}/cgi-bin/ljlib.pl";
+require "$ENV{'LJHOME'}/cgi-bin/ljviews.pl";
+
+my $dbh = LJ::get_db_writer();
+
+sub header_text {
+ return <<"HEADER";
+# This file is automatically generated from MySQL by \$LJHOME/bin/dumpsql.pl
+# Don't submit a diff against a hand-modified file - dump and diff instead.
+
+HEADER
+}
+
+# what tables don't we want to export the auto_increment columns from
+# because they already have their own unique string, which is what matters
+my %skip_auto = (
+ "priv_list" => "privcode",
+ "supportcat" => "catkey",
+ "ratelist" => "name",
+ );
+
+# get tables to export
+my %tables = ();
+my $sth = $dbh->prepare("SELECT tablename, redist_mode, redist_where ".
+ "FROM schematables WHERE redist_mode NOT IN ('off')");
+$sth->execute;
+while (my ($table, $mode, $where) = $sth->fetchrow_array) {
+ $tables{$table}->{'mode'} = $mode;
+ $tables{$table}->{'where'} = $where;
+}
+
+my %output; # {general|local} -> [ [ $alphasortkey, $SQL ]+ ]
+
+# dump each table.
+foreach my $table (sort keys %tables)
+{
+ next if $table =~ /^(user|talk|log)proplist$/;
+
+ my $where;
+ if ($tables{$table}->{'where'}) {
+ $where = "WHERE $tables{$table}->{'where'}";
+ }
+
+ my $sth = $dbh->prepare("DESCRIBE $table");
+ $sth->execute;
+ my @cols = ();
+ my $skip_auto = 0;
+ while (my $c = $sth->fetchrow_hashref) {
+ if ($c->{'Extra'} =~ /auto_increment/ && $skip_auto{$table}) {
+ $skip_auto = 1;
+ } else {
+ push @cols, $c;
+ }
+ }
+
+ # DESCRIBE table can be different between developers
+ @cols = sort { $a->{'Field'} cmp $b->{'Field'} } @cols;
+
+ my $cols = join(", ", map { $_->{'Field'} } @cols);
+ my $sth = $dbh->prepare("SELECT $cols FROM $table $where");
+ $sth->execute;
+ my $sql;
+ while (my @r = $sth->fetchrow_array)
+ {
+ my %vals;
+ my $i = 0;
+ foreach (map { $_->{'Field'} } @cols) {
+ $vals{$_} = $r[$i++];
+ }
+ my $scope = "general";
+ $scope = "local" if (defined $vals{'scope'} &&
+ $vals{'scope'} eq "local");
+ my $verb = "INSERT IGNORE";
+ $verb = "REPLACE" if ($tables{$table}->{'mode'} eq "replace" &&
+ ! $skip_auto);
+ $sql = "$verb INTO $table ";
+ $sql .= "($cols) ";
+ $sql .= "VALUES (" . join(", ", map { db_quote($_) } @r) . ");\n";
+
+ my $uniqc = $skip_auto{$table};
+ my $skey = $uniqc ? $vals{$uniqc} : $sql;
+ push @{$output{$scope}}, [ "$table.$skey.1", $sql ];
+
+ if ($skip_auto) {
+ # for all the *proplist tables, there might be new descriptions
+ # or columns, but we can't do a REPLACE, because that'd mess
+ # with their auto_increment ids, so we do insert ignore + update
+ my $where = "$uniqc=" . db_quote($vals{$uniqc});
+ delete $vals{$uniqc};
+ $sql = "UPDATE $table SET ";
+ $sql .= join(",", map { "$_=" . db_quote($vals{$_}) } sort keys %vals);
+ $sql .= " WHERE $where;\n";
+ push @{$output{$scope}}, [ "$table.$skey.2", $sql ];
+ }
+ }
+}
+
+
+# don't use $dbh->quote because it's changed between versions
+# and developers sending patches can't generate concise patches
+# it used to not quote " in a single quoted string, but later it does.
+# so we'll implement the new way here.
+sub db_quote {
+ my $s = shift;
+ return "NULL" unless defined $s;
+ $s =~ s/\\/\\\\/g;
+ $s =~ s/\"/\\\"/g;
+ $s =~ s/\'/\\\'/g;
+ $s =~ s/\n/\\n/g;
+ $s =~ s/\r/\\r/g;
+ return "'$s'";
+}
+
+foreach my $k (keys %output) {
+ my $file = $k eq "general" ? "base-data.sql" : "base-data-local.sql";
+ print "Dumping $file\n";
+ my $ffile = "$ENV{'LJHOME'}/bin/upgrading/$file";
+ open (F, ">$ffile") or die "Can't write to $ffile\n";
+ print F header_text();
+ foreach (sort { $a->[0] cmp $b->[0] } @{$output{$k}}) {
+ print F $_->[1];
+ }
+ close F;
+}
+
+# dump proplists, etc
+print "Dumping proplists.dat\n";
+open (my $plg, ">$ENV{LJHOME}/bin/upgrading/proplists.dat") or die;
+open (my $pll, ">$ENV{LJHOME}/bin/upgrading/proplists-local.dat") or die;
+foreach my $table ('userproplist', 'talkproplist', 'logproplist', 'usermsgproplist') {
+ my $sth = $dbh->prepare("DESCRIBE $table");
+ $sth->execute;
+ my @cols = ();
+ while (my $c = $sth->fetchrow_hashref) {
+ die "Where is the 'Extra' column?" unless exists $c->{'Extra'}; # future-proof
+ next if $c->{'Extra'} =~ /auto_increment/;
+ push @cols, $c;
+ }
+ @cols = sort { $a->{'Field'} cmp $b->{'Field'} } @cols;
+ my $cols = join(", ", map { $_->{'Field'} } @cols);
+
+ my $pri_key = "name"; # for now they're all 'name'. might add more tables.
+ $sth = $dbh->prepare("SELECT $cols FROM $table ORDER BY $pri_key");
+ $sth->execute;
+ while (my @r = $sth->fetchrow_array) {
+ my %vals;
+ my $i = 0;
+ foreach (map { $_->{'Field'} } @cols) {
+ $vals{$_} = $r[$i++];
+ }
+ my $scope = $vals{'scope'} && $vals{'scope'} eq "local" ? "local" : "general";
+ my $fh = $scope eq "local" ? $pll : $plg;
+ print $fh "$table.$vals{$pri_key}:\n";
+ foreach my $c (map { $_->{'Field'} } @cols) {
+ next if $c eq $pri_key;
+ next if $c eq "scope"; # implied by filenamea
+ print $fh " $c: $vals{$c}\n";
+ }
+ print $fh "\n";
+ }
+
+}
+
+# now dump school related information
+print "Dumping schools.dat\n";
+open(F, ">$ENV{LJHOME}/bin/upgrading/schools.dat") or die;
+$sth = $dbh->prepare('SELECT name, country, state, city, url FROM schools');
+$sth->execute;
+while (my @row = $sth->fetchrow_array) {
+ my $line = '"' . join('","', map { $_ || "" } @row) . '"';
+ print F "$line\n";
+}
+close F;
+
+# and do S1 styles (ugly schema)
+print "Dumping s1styles.dat\n";
+require "$ENV{'LJHOME'}/bin/upgrading/s1style-rw.pl";
+my $ss = {};
+my $pubstyles = LJ::S1::get_public_styles({ 'formatdata' => 1});
+foreach my $s (values %$pubstyles) {
+ my $uniq = "$s->{'type'}/$s->{'styledes'}";
+ $ss->{$uniq}->{$_} = $s->{$_} foreach keys %$s;
+}
+s1styles_write($ss);
+
+# and dump mood info
+print "Dumping moods.dat\n";
+open (F, ">$ENV{'LJHOME'}/bin/upgrading/moods.dat") or die;
+$sth = $dbh->prepare("SELECT moodid, mood, parentmood FROM moods ORDER BY moodid");
+$sth->execute;
+while (@_ = $sth->fetchrow_array) {
+ print F "MOOD @_\n";
+}
+
+$sth = $dbh->prepare("SELECT moodthemeid, name, des FROM moodthemes WHERE is_public='Y' ORDER BY name");
+$sth->execute;
+while (my ($id, $name, $des) = $sth->fetchrow_array) {
+ $name =~ s/://;
+ print F "MOODTHEME $name : $des\n";
+ my $std = $dbh->prepare("SELECT moodid, picurl, width, height FROM moodthemedata ".
+ "WHERE moodthemeid=$id ORDER BY moodid");
+ $std->execute;
+ while (@_ = $std->fetchrow_array) {
+ print F "@_\n";
+ }
+}
+close F;
+
+
+print "Done.\n";
View
179 bin/evwatch
@@ -0,0 +1,179 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use lib "$ENV{LJHOME}/cgi-bin";
+require 'ljlib.pl';
+
+$|++;
+
+use Errno qw(EAGAIN EWOULDBLOCK);
+use LJ::Blockwatch;
+use IO::Socket::INET;
+use Time::HiRes qw(tv_interval);
+
+my %files;
+my %filetimes;
+my $last_time_checked = time();
+
+my %time_averages;
+
+my %sockets; # fileno -> IO::Socket::INET socket
+my %socket_destinations; # fileno -> "hostname:port"
+
+
+#############################################################################
+# This block handles initial connections to the nodes we want to listen to.
+# The list is hard coded in the @destinations list for the moment.
+#############################################################################
+
+{
+ my %connecting_sockets;
+ my @destinations = qw(localhost:7600 127.0.0.1:7600);
+
+ foreach my $dest (@destinations) {
+ my $sock = IO::Socket::INET->new( PeerHost => $dest, Blocking => 0 ) or die "Couldn't connect: $!";
+ $connecting_sockets{$sock->fileno} = $sock;
+ $socket_destinations{$sock->fileno} = $dest;
+ }
+
+ sleep 3;
+
+ my $win = '';
+ foreach my $fd (keys %connecting_sockets) {
+ vec($win, $fd, 1) = 1;
+ }
+ select(undef, my $wout = $win, undef, 0);
+
+ while (my ($fd, $sock) = each %connecting_sockets) {
+ if (vec($wout, $fd, 1)) {
+ $sockets{$fd} = $sock;
+ $sock->write("evwatch\n");
+ }
+ }
+}
+
+die "Nothing allowed us to connect" unless keys %sockets;
+
+my %socket_buffers = map { ($_, '') } keys %sockets; # fileno -> buffer
+
+#############################################################################
+# This block handles listening to each of the sockets for reading and handing
+# the incoming data off to sub process_line anytime there has been a full
+# line read.
+#############################################################################
+
+while (1) {
+ my $rin = '';
+ foreach my $fd (keys %sockets) {
+ vec($rin, $fd, 1) = 1;
+ }
+ select(my $rout = $rin, undef, undef, undef);
+
+ # Read data from the sockets that are ready
+ SOCK: foreach my $fd (keys %sockets) {
+ my $sock = $sockets{$fd};
+ my $bufref = \$socket_buffers{$fd};
+
+ if (vec($rout, $fd, 1)) {
+ READ: while (1) {
+ my $length = sysread($sock, my $read_buffer, 1024);
+
+ if ($length) {
+ $$bufref .= $read_buffer;
+ next READ; # Read again, till we get a read error.
+ }
+
+ if ($! == EAGAIN || $! == EWOULDBLOCK) {
+ last READ; # We've read all we can on this loop.
+ }
+
+ # Other errors mean we just close the connection and move on.
+ delete $sockets{$fd};
+ delete $socket_buffers{$fd};
+ next SOCK;
+ }
+
+ my $dest = $socket_destinations{$fd};
+
+ while ($$bufref =~ s/(.*?)\r?\n//) {
+ my $line = $1;
+ next unless $line;
+ my ($filename, $time, $utime, $direction, $event) = split /,/, $line;
+ process_line("${dest}${filename}", $time, $utime, $direction, $event);
+ }
+ }
+ }
+}
+
+#############################################################################
+# Process a line of incoming data, arguments are:
+# label - hostname and filename concatted together
+# time, utime - pair of integers that report when this event happened
+# direction - boolean indicating the direction of this event
+# begin is 0
+# end is 1
+# event - integer representing the event that occurred
+#############################################################################
+
+sub process_line {
+ my ($label, $time, $utime, $direction, $event) = @_;
+ my $filename = $label;
+ my $current_time = time();
+
+ $filetimes{$filename} = $current_time;
+ my $filedata = $files{$filename} ||= {};
+
+ my $eventdata = $filedata->{$event} ||= [];
+
+ if ($direction) { # backing out one operation
+ my $start_times = pop @$eventdata;
+ delete $filedata->{$event} unless @$eventdata;
+ return unless $start_times;
+ my $interval = tv_interval($start_times, [$time, $utime]);
+ my $average = \$time_averages{$event};
+ if (defined $$average) {
+ $$average *= .95;
+ $$average += ($interval * .05);
+ } else {
+ $$average = $interval;
+ }
+ } else { # adding an event
+ push @$eventdata, [$time, $utime];
+ }
+
+ if ($last_time_checked + 1 <= $current_time) {
+ $last_time_checked = $current_time;
+
+ foreach my $key (keys %filetimes) {
+ if ($filetimes{$key} < $current_time - 10) {
+ print "Removing $key.\n";
+ delete $filetimes{$key};
+ delete $files{$key};
+ }
+ }
+ dump_stats();
+ }
+}
+
+
+sub dump_stats {
+ while (my ($filename, $filedata) = each %files) {
+ next unless keys %$filedata;
+ print "For '$filename'\n";
+
+ while (my ($event, $times) = each %$filedata) {
+ my $event_name = LJ::Blockwatch->get_event_name($event);
+ print " $event_name has " . @$times . " outstanding.\n";
+ }
+ } continue { print "\n"; }
+
+ foreach my $event (map {$_->[1]}
+ sort {$a->[0] <=> $b->[0]}
+ map { [$time_averages{$_}, $_] }
+ keys %time_averages) {
+ my $time = $time_averages{$event};
+ my $event_name = LJ::Blockwatch->get_event_name($event);
+ printf "$time\t$event_name\n";
+ }
+ print "\n";
+}
View
53 bin/fakesms-djabberd
@@ -0,0 +1,53 @@
+#!/usr/bin/perl
+
+use strict;
+use lib "$ENV{LJHOME}/cgi-bin";
+use lib "$ENV{LJHOME}/src/djabberd/lib";
+require 'ljconfig.pl';
+
+use DJabberd;
+use DJabberd::Authen::AllowedUsers;
+use DJabberd::Authen::StaticPassword;
+use DJabberd::Delivery::Local;
+use DJabberd::FakeSMS;
+use Getopt::Long;
+
+use vars qw($DEBUG);
+$DEBUG = 0;
+
+my ($daemonize);
+
+Getopt::Long::GetOptions(
+ 'd|daemon' => \$daemonize,
+ 'debug=i' => \$DEBUG,
+ );
+
+use FindBin qw($Bin);
+
+use DJabberd::VHost;
+my $vhost = DJabberd::VHost->new(
+ server_name => $LJ::DOMAIN,
+ s2s => 0,
+ plugins => [
+ DJabberd::Authen::AllowedUsers->new(policy => "deny",
+ allowedusers => [qr/^\+?\d+/, 'sms']),
+ DJabberd::Authen::StaticPassword->new(password => "smstest"),
+ DJabberd::Delivery::FakeSMS->new(),
+ DJabberd::Delivery::Local->new(),
+ DJabberd::RosterStorage::FakeSMS->new(),
+ DJabberd::PresenceChecker::FakeSMS->new(),
+ ],
+ );
+
+my $server = DJabberd->new(
+ daemonize => $daemonize,
+ );
+
+$server->add_vhost($vhost);
+
+# incoming
+$server->start_simple_server(5224);
+
+$server->run;
+
+
View
144 bin/fingerd.pl
@@ -0,0 +1,144 @@
+#!/usr/bin/perl
+#
+# finger server.
+#
+# accepts two optional arguments, host and port.
+# doesn't daemonize.
+#
+#
+# <LJDEP>
+# lib: Socket::, Text::Wrap, cgi-bin/ljlib.pl
+# </LJDEP>
+
+my $bindhost = shift @ARGV;
+my $port = shift @ARGV;
+
+unless ($bindhost) {
+ $bindhost = "0.0.0.0";
+}
+
+require "$ENV{'LJHOME'}/cgi-bin/ljlib.pl";
+
+use Socket;
+use Text::Wrap;
+
+$SIG{'INT'} = sub {
+ print "Interrupt caught!\n";
+ close FH;
+ close CL;
+ exit;
+};
+
+my $proto = getprotobyname('tcp');
+socket(FH, PF_INET, SOCK_STREAM, $proto) || die $!;
+
+$port ||= 79;
+my $localaddr = inet_aton($bindhost);
+my $sin = sockaddr_in($port, $localaddr);
+setsockopt (FH,SOL_SOCKET,SO_REUSEADDR,1) or
+ die "setsockopt() failed: $!\n";
+bind (FH, $sin) || die $!;
+
+listen(FH, 10);
+
+while (LJ::start_request())
+{
+ accept(CL, FH) || die $!;
+
+ my $line = <CL>;
+ chomp $line;
+ $line =~ s/\0//g;
+ $line =~ s/\s//g;
+
+ if ($line eq "") {
+ print CL "Welcome to the $LJ::SITENAME finger server!
+
+You can make queries in the following form:
+
+ \@$LJ::DOMAIN - this help message
+ user\@$LJ::DOMAIN - their userinfo
+";
+ close CL;
+ next;
+ }
+
+ my $dbr = LJ::get_dbh("slave", "master");
+
+ if ($line =~ /^(\w{1,15})$/) {
+ # userinfo!
+ my $user = $1;
+ my $quser = $dbr->quote($user);
+ my $sth = $dbr->prepare("SELECT user, has_bio, caps, userid, name, email, bdate, allow_infoshow FROM user WHERE user=$quser");
+ $sth->execute;
+ my $u = $sth->fetchrow_hashref;
+ unless ($u) {
+ print CL "\nUnknown user ($user)\n";
+ close CL;
+ next;
+ }
+
+ my $bio;
+ if ($u->{'has_bio'} eq "Y") {
+ $sth = $dbr->prepare("SELECT bio FROM userbio WHERE userid=$u->{'userid'}");
+ $sth->execute;
+ ($bio) = $sth->fetchrow_array;
+ }
+ delete $u->{'has_bio'};
+
+ $u->{'accttype'} = LJ::name_caps($u->{'caps'});
+
+ if ($u->{'allow_infoshow'} eq "Y") {
+ LJ::load_user_props($dbr, $u, "opt_whatemailshow",
+ "country", "state", "city", "zip",
+ "aolim", "icq", "url", "urlname",
+ "yahoo", "msn");
+ } else {
+ $u->{'opt_whatemailshow'} = "N";
+ }
+ delete $u->{'allow_infoshow'};
+
+ if ($u->{'opt_whatemailshow'} eq "L") {
+ delete $u->{'email'};
+ }
+ if ($LJ::USER_EMAIL && LJ::get_cap($u, "useremail")) {
+ if ($u->{'email'}) { $u->{'email'} .= ", "; }
+ $u->{'email'} .= "$user\@$LJ::USER_DOMAIN";
+ }
+
+ if ($u->{'opt_whatemailshow'} eq "N") {
+ delete $u->{'email'};
+ }
+ delete $u->{'opt_whatemailshow'};
+
+ my $max = 1;
+ foreach (keys %$u) {
+ if (length($_) > $max) { $max = length($_); }
+ }
+ $max++;
+
+ delete $u->{'caps'};
+
+ print CL "\nUserinfo for $user...\n\n";
+ foreach my $k (sort keys %$u) {
+ printf CL "%${max}s : %s\n", $k, $u->{$k};
+ }
+
+ if ($bio) {
+ $bio =~ s/^\s+//;
+ $bio =~ s/\s+$//;
+ print CL "\nBio:\n\n";
+ $Text::Wrap::columns = 77;
+ print CL Text::Wrap::wrap(" ", " ", $bio);
+ }
+ print CL "\n\n";
+
+ close CL;
+ next;
+
+ }
+
+ print CL "Unsupported/unimplemented query type: $line\n";
+ print CL "length: ", length($line), "\n";
+ close CL;
+ next;
+}
View
166 bin/gens2editlib.pl
@@ -0,0 +1,166 @@
+#!/usr/bin/perl
+# ----------------------------------------------------------------------------
+# S2 editor library generation script 08/03/2005
+#
+# Generates s2library.js from the core layer definitions.
+# ----------------------------------------------------------------------------
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+
+my ($filename, $layerid, $query, $outputpath, $help);
+GetOptions(
+ 'help|h' => \$help,
+ 'filename|f=s' => \$filename,
+ 'layerid|l=i' => $layerid,
+ 'query|q' => \$query,
+ 'output|o=s' => \$outputpath) or pod2usage(1);
+pod2usage(0) if $help;
+
+my $home = $ENV{LJHOME} or die "You'll have to set \$LJHOME first.\n";
+require "$home/cgi-bin/ljlib.pl";
+require "$home/cgi-bin/LJ/S2.pm";
+
+$outputpath ||= "$home/htdocs/customize/advanced/s2edit/s2library.js";
+
+my $info;
+if ($filename) {
+ local $/ = undef;
+ open F, $filename or die $!;
+ eval <F>;
+ die $@ if $@;
+ close F;
+
+ $info = S2::get_layer_all(defined($layerid) ? $layerid : 1);
+} elsif ($query) {
+ my $pub = LJ::S2::get_public_layers();
+ my $id = $pub->{core1};
+ $id = $id ? $id->{'s2lid'} : 0;
+ die "Couldn't locate a core 1 layer.\n" unless $id;
+
+ my $dbr = LJ::get_db_reader();
+ my $rv = S2::load_layers_from_db($dbr, $id);
+ $info = S2::get_layer_all($id);
+} else {
+ pod2usage(1);
+}
+
+open LIB, ">$outputpath" or die "Failed to open $outputpath for writing: $!\n";
+select LIB;
+print "// Automatically generated by gens2editlib.pl\n";
+print "// Do not edit!\n\n";
+
+# ----------------------------------------------------------------------------
+# Classes
+# ----------------------------------------------------------------------------
+
+print "// Classes\n";
+print "var s2classlib = new Array(";
+
+my %classes = %{$info->{'class'}};
+my @orderedClasses = map { $_->[0] } sort { $a->[1] cmp $b->[1] } map
+ { [ $_, lc $_ ] } keys %classes;
+
+my $cma = 0;
+
+foreach my $className (@orderedClasses) {
+ my $class = $classes{$className};
+
+ my (%methods, %members);
+ my $c = $class;
+ do {
+ %methods = (%methods, %{$c->{funcs}});
+ %members = (%members, %{$c->{vars}});
+
+ $c = ($c->{'parent'} ? $classes{$c->{'parent'}} : undef);
+ } while ($c);
+
+ print "," if $cma++;
+
+ print "\n\t{\n\t\tname: '$className',\n";
+
+ print "\t\tmembers: new Array(";
+ my $cm = 0;
+ foreach my $memberName (sort keys %members) {
+ print "," if $cm++;
+
+ print "\n\t\t\t{ ";
+ print "name: '$memberName', ";
+ print "type: '$members{$memberName}->{type}'";
+ print " }";
+ }
+ print "),\n";
+
+ print "\t\tmethods: new Array(";
+ $cm = 0;
+ foreach my $methodName (sort keys %methods) {
+ print "," if $cm++;
+
+ print "\n\t\t\t{ ";
+ print "name: '$methodName', ";
+ print "type: '$methods{$methodName}->{returntype}'";
+ print " }";
+ }
+ print ")\n";
+
+ print "\t}";
+}
+print ");\n\n";
+
+# ----------------------------------------------------------------------------
+# Functions
+# ----------------------------------------------------------------------------
+
+print "// Functions\n";
+my $global = $info->{'global'};
+print "var s2funclib = new Array(";
+
+my $cm = 0;
+foreach my $func (sort keys %$global) {
+ print "," if $cm++;
+
+ print "\n\t{ name: '$func', type: '$global->{$func}{returntype}' }";
+}
+print ");\n\n";
+
+# ----------------------------------------------------------------------------
+# Properties
+# ----------------------------------------------------------------------------
+
+print "// Properties\n";
+my $props = $info->{'prop'};
+print "var s2proplib = new Array(";
+
+$cm = 0;
+foreach my $prop (sort keys %$props) {
+ print "," if $cm++;
+
+ print "\n\t{ name: '$prop', type: '$props->{$prop}{type}' }";
+}
+print ");\n";
+
+print "\n// End\n";
+
+__END__
+
+=head1 NAME
+
+gens2editlib.pl - generate the LJ S2 editor library file for core layer 1
+
+=head1 SYNOPSIS
+
+gens2editlib.pl [-q] [-f core1.pl] [-l layerid] [-h] [-o ./s2library.js]
+
+ Options consist of:
+ -f, --file specify path to layer compiled with s2compile.pl
+ -h, --help print this help message
+ -l, --layerid specify layer ID number with -f option; defaults to 1
+ -q, --query query local database to obtain S2 core layer
+ -o, --output specify where to put the generated JavaScript; defaults to
+ $LJHOME/htdocs/customize/advanced/s2edit/s2library.js
+
+ You must specify either the -q or the -f option.
+
+=cut
View
105 bin/incoming-mail-inject.pl
@@ -0,0 +1,105 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+BEGIN {
+ $ENV{LJHOME} ||= "/home/lj";
+}
+use lib "$ENV{LJHOME}/cgi-bin";
+require "$ENV{LJHOME}/cgi-bin/ljlib.pl";
+use Class::Autouse qw(
+ LJ::IncomingEmailHandle
+ );
+
+my $sclient = LJ::theschwartz() or die "No schwartz config.\n";
+
+my $tempfail = sub {
+ my $msg = shift;
+ warn "Failure: $msg\n" if $msg;
+ # makes postfix do temporary failure:
+ exit(75);
+};
+
+# below this size, we put in database directly. if over,
+# we put in mogile.
+sub IN_MEMORY_THRES () {
+ return