init

obsolete/bin/rlj2lj.pl

@@ -0,0 +1,405 @@
+#!/usr/bin/perl -w
+use strict;
+use XMLRPC::Lite;
+use Digest::MD5 qw(md5_hex);
+use DBI;
+use Time::Local;
+use lib "$ENV{'LJHOME'}/cgi-bin";
+use LJR::Viewuserstandalone;
+
+do $ENV{'LJHOME'} . "/cgi-bin/ljconfig.pl";
+#
+#îÁÓÔÒÏÊËÉ
+#
+
+#ó×ÏÊÓÔ×Á ÓÏÅÄÉÎÅÎÉÑ Ó ÂÁÚÏÊ
+my $qhost = $LJ::DBINFO{'master'}->{'host'};
+my $quser = $LJ::DBINFO{'master'}->{'user'};
+my $qpass = $LJ::DBINFO{'master'}->{'pass'};
+my $qsock = $LJ::DBINFO{'master'}->{'sock'};
+my $qport = $LJ::DBINFO{'master'}->{'port'};
+#my $qdb = $LJ::DBINFO{'master'}->{'dbname'};
+my $qdb = "prod_ljgate";
+
+#óÁÊÔ, Ó ËÏÔÏÒÏÇÏ ËÏÐÉÒÕÅÍ
+my $source_site = "127.0.0.2";
+
+#óÁÊÔ, ÎÁ ËÏÔÏÒÏÊ ËÏÐÉÒÕÅÍ
+my $dest_site = "www.livejournal.com";
+
+#þÁÓÔÏÔÁ ÓÉÎÈÒÏÎÉÚÁÃÉÉ × ÆÏÒÍÁÔÅ þþ:íí:óó
+#(ÔÏ ÅÓÔØ ÓÉÎÈÒÏÎÉÚÁÃÉÑ ËÁÖÄÙÅ 15 ÍÉÎÕÔ ÂÕÄÅÔ ×ÙÇÌÑÄÅÔØ ËÁË
+#00:15:00
+my $sync_freq = "00:10:00";
+
+#òÁÚÎÉÃÁ ×Ï ×ÒÅÍÅÎÉ ÍÅÖÄÕ ÍÁÛÉÎÏÊ, ÎÁ ËÏÔÏÒÏÊ ÕÓÔÁÎÏ×ÌÅÎ ÇÅÊÔ,
+#É ÍÁÛÉÎÏÊ, ÎÁ ËÏÔÏÒÏÊ ÕÓÔÁÎÏ×ÌÅÎ ÉÓÈÏÄÎÙÊ LJ-ÓÅÒ×ÅÒ (ÚÁÐÉÓÉ
+#ÄÁÔÉÒÕÀÔÓÑ ÌÏËÁÌØÎÙÍ ×ÒÅÍÅÎÅÍ ÐÏÌØÚÏ×ÁÔÅÌÑ, Á ×ÒÅÍÑ ÓÉÎÈÒÏÎÉÚÁÃÉÉ
+#ÏÔÓÞÉÔÙ×ÁÅÔÓÑ ÐÏ ÞÁÓÁÍ ÍÁÛÉÎÙ, ÇÄÅ ËÒÕÔÉÔÓÑ LJ, ÂÌÉÎ).
+#òÁÚÎÉÃÁ ÕËÁÚÙ×ÁÅÔÓÑ × ËÏÌÉÞÅÓÔ×Å ÓÅËÕÎÄ. åÓÌÉ ×ÒÅÍÑ ÇÅÊÔÁ ÍÅÎØÛÅ
+#×ÒÅÍÅÎÉ ÓÅÒ×ÅÒÁ, ÒÁÚÎÉÃÁ ÄÏÌÖÎÁ ÂÙÔØ ÐÏÌÏÖÉÔÅÌØÎÙÍ ÞÉÓÌÏÍ, ÂÏÌØÛÅ ---
+#ÐÏÎÑÔÎÏÅ ÄÅÌÏ, ÏÔÒÉÃÁÔÅÌØÎÙÍ.
+my $time_diff = 0;
+
+#îÁÓÔÒÏÊËÉ ÚÁËÏÎÞÉÌÓØ
+
+#áËËÁÕÎÔ, ËÏÔÏÒÙÊ ËÏÐÉÒÕÅÍ
+my $source_user;
+my $source_pass;
+
+#áËËÁÕÎÔ, × ËÏÔÏÒÙÊ ËÏÐÉÒÕÅÍ
+my $dest_user;
+my $dest_pass;
+
+#úÄÅÓØ ÂÕÄÕÔ ÈÒÁÎÉÔØÓÑ ÌÏÇÉÎÙ É ÐÁÒÏÌÉ ÓÉÎÈÒÏÎÉÚÉÒÕÅÍÙÈ
+#ÄÎÅ×ÎÉËÏ× (ÎÁ ÎÁÛÅÍ É ÞÕÖÏÍ ÓÅÒ×ÅÒÁÈ)
+my %journals;
+
+open (STDERR, "+>>$ENV{LJHOME}/logs/ljgate.log") || die "Can't open logfile:$!";
+
+#÷ÙÞÉÓÌÑÅÍ ×ÒÅÍÑ ÐÒÅÄÙÄÕÝÅÇÏ ÏÂÎÏ×ÌÅÎÉÑ
+my ($fr_hour,$fr_min,$fr_sec);
+my ($ls_year,$ls_month,$ls_day,$ls_hour,$ls_min,$ls_sec);
+($fr_hour,$fr_min,$fr_sec) = split(/:/,$sync_freq);
+my $lastsync = (time() - ($fr_hour * 60 * 60)
+                    - ($fr_min * 60)
+	            - $fr_sec);
+$lastsync = $lastsync + $time_diff;
+($ls_sec,$ls_min,$ls_hour,$ls_day,$ls_month,$ls_year) = localtime($lastsync);
+$ls_year += 1900;
+$ls_month += 1;
+$ls_month=sprintf("%.02d",$ls_month);
+$ls_day=sprintf("%.02d",$ls_day); 
+$ls_sec=sprintf("%.02d",$ls_sec);
+$ls_min=sprintf("%.02d",$ls_min); 
+$ls_hour=sprintf("%.02d",$ls_hour); 
+$lastsync = $ls_year."-".
+            $ls_month."-".
+            $ls_day." ".
+            $ls_hour.":".
+            $ls_min.":".
+            $ls_sec;
+#print "$lastsync\n";
+
+#ó×ÑÚÙ×ÁÅÍÓÑ Ó ÂÁÚÏÊ
+my $dbh = DBI->connect(
+   "DBI:mysql:mysql_socket=$qsock;hostname=$qhost;port=$qport;database=$qdb",
+   $quser, $qpass,
+   ) || die  localtime(time) . ": Can't connect to database\n";
+
+#úÁÂÉÒÁÅÍ ÉÚ ÂÁÚÙ ID ÖÕÒÎÁÌÏ×, ËÏÔÏÒÙÅ ÎÕÖÎÏ ÓÉÎÈÒÏÎÉÚÉÒÏ×ÁÔØ
+my $sqh = $dbh->prepare("SELECT userid,alienid
+                      FROM rlj2lj");
+$sqh->execute;
+
+my $result;
+
+#ðÏÍÅÝÁÅÍ ÒÅÚÕÌØÔÁÔÙ ÚÁÐÒÏÓÁ × ÈÜÛ %journals
+while ($result = $sqh->fetchrow_hashref) {
+    $journals{$result->{'userid'}} = $result->{'alienid'};
+}
+
+#éÎÉÃÉÁÌÉÚÉÒÕÅÍ ÉÎÔÅÒÆÅÊÓ ÐÒÏÔÏËÏÌÁ XMLRPC
+my $xmlrpc = new XMLRPC::Lite;
+
+#óÉÎÈÒÏÎÉÚÉÒÕÅÍ ÖÕÒÎÁÌÙ
+foreach (keys(%journals)) {
+    #úÁÂÉÒÁÅÍ ÉÚ ÂÁÚÙ ÏÞÅÒÅÄÎÏÇÏ ÐÏÌØÚÏ×ÁÔÅÌÑ ÉÓÈÏÄÎÏÇÏ ÖÕÒÎÁÌÁ
+    $sqh = $dbh->prepare("SELECT our_user,our_pass
+                          FROM our_user
+                          WHERE userid=$_");
+    $sqh->execute;
+    ($source_user,$source_pass) = $sqh->fetchrow_array;
+
+    #úÁÂÉÒÁÅÍ ÉÚ ÂÁÚÙ ÏÞÅÒÅÄÎÏÇÏ ÐÏÌØÚÏ×ÁÔÅÌÑ ÞÕÖÏÇÏ ÓÅÒ×ÉÓÁ
+    $sqh = $dbh->prepare("SELECT alien,alienpass
+                          FROM alien
+                          WHERE alienid=$journals{$_}");
+    $sqh->execute;
+    ($dest_user,$dest_pass) = $sqh->fetchrow_array;
+
+    #ëÏÐÉÒÕÅÍ ×ÓÅ ÚÁÐÉÓÉ, ÄÏÂÁ×ÌÅÎÎÙÅ ÉÌÉ ÉÚÍÅΣÎÎÙÅ
+    #ÐÏÓÌÅ ÐÒÅÄÙÄÕÝÅÇÏ ÏÂÎÏ×ÌÅÎÉÑ
+    eval {
+	sync_journals($source_site,$source_user,$source_pass,
+	      $dest_site,$dest_user,$dest_pass,
+	      $lastsync,$_);
+    };
+    if ($@) {
+	print STDERR localtime(time) . ": Syncronizing $source_user failed\n";
+    }   
+}
+
+
+###SUBROUTINES###
+
+
+#óÉÎÈÒÏÎÉÚÁÃÉÑ ÄÎÅ×ÎÉËÏ×
+sub sync_journals{
+ my ($source_site,$souce_user,$source_pass,
+     $dest_site,$dest_user,$dest_pass,
+     $lastsync, $user_id);
+
+ #ðÏÌÕÞÁÅÍ ÁÄÒÅÓÁ ÉÓÐÏÌØÚÕÅÍÙÈ ÓÁÊÔÏ× É ÐÁÒÏÌÉ/ÌÏÇÉÎÙ
+ #ÓÉÎÈÒÏÎÉÚÉÒÕÅÍÙÈ ÁËËÁÕÎÔÏ× ÉÚ ÓÔÒÏËÉ Ó ÁÒÇÕÍÅÎÔÁÍÉ
+ ($source_site,$souce_user,$source_pass,
+  $dest_site,$dest_user,$dest_pass,$lastsync,$user_id) = @_;
+
+ my $proxy = "http://" . $source_site . "/interface/xmlrpc";
+ $xmlrpc->proxy($proxy);
+
+ #XMLRPC object, for login call
+ my $get_challenge;
+
+ #Challenge (random string from server for secure login)
+ my $challenge;
+
+ #String for md5 hash of server challenge and password
+ my $response;
+
+ #ðÏÌÕÞÁÅÍ ÐÁÒÕ ÐÁÒÏÌØ-ÏÔÚÙ× Õ ÉÓÈÏÄÎÏÇÏ ÓÅÒ×ÅÒÁ
+ eval {
+     $get_challenge = xmlrpc_call("LJ.XMLRPC.getchallenge");
+     $challenge = $get_challenge->{'challenge'};
+     $response = md5_hex($challenge . md5_hex($source_pass));
+ };
+ #Error handling (russian over ssh doesn't work, sorry)
+ if ($@) {
+     print STDERR localtime(time) . ": Login on $source_site failed\n";
+     die;
+ };
+
+ #XMLRPC object, for "getevents" call
+ my $getevents;
+
+ #úÁÂÉÒÁÅÍ ×ÓÅ ÓÏÏÂÝÅÎÉÑ, ÐÏÑ×É×ÛÉÅÓÑ ÓÏ ×ÒÅÍÅÎÉ ÐÏÓÌÅÄÎÅÊ ÓÉÎÈÒÏÎÉÚÁÃÉÉ
+ eval {
+     $getevents = xmlrpc_call('LJ.XMLRPC.getevents', {
+	'username' => $source_user,
+	'auth_method' => 'challenge',
+	'auth_challenge' => $challenge,
+	'auth_response' => $response,
+	'ver' => 1,
+	'selecttype' => 'syncitems',
+	'lastsync' => $lastsync,
+	'lineendings' => 'unix',
+    });
+ };
+ #Error handling
+ if ($@) {
+     print STDERR localtime(time) . ": Getevents on $source_site failed\n";
+     die;
+ }
+
+ $proxy = "http://" . $dest_site . "/interface/xmlrpc";
+ $xmlrpc->proxy($proxy);
+
+ #ðÏÌÕÞÁÅÍ ÐÁÒÕ ÐÁÒÏÌØ-ÏÔÚÙ× Õ ÓÅÒ×ÅÒÁ, ÎÁ ËÏÔÏÒÙÊ ËÏÐÉÒÕÅÍ ÚÁÐÉÓÉ
+ eval {
+     $get_challenge = xmlrpc_call("LJ.XMLRPC.getchallenge");
+     $challenge = $get_challenge->{'challenge'};
+     $response = md5_hex($challenge . md5_hex($dest_pass));
+ };
+ #Error handling
+ if ($@) {
+     print STDERR localtime(time) . ": Login on $dest_site failed\n";
+     print STDERR "debug1: " . $@;
+     print STDERR "\n\n";
+     die;
+ }
+
+ my $entry;
+
+ my( $entry_date, $entry_time, $sec, $min, $hour, $day, $month, $year );
+
+ my $fields;
+
+ my $postevent;
+
+ foreach $entry (@{$getevents->{'events'}}) {
+    #ðÏÌÕÞÁÅÍ ÐÁÒÕ ÐÁÒÏÌØ-ÏÔÚÙ× Õ ÓÅÒ×ÅÒÁ, ÎÁ ËÏÔÏÒÙÊ ÐÅÒÅÎÏÓÉÍ ÚÁÐÉÓÉ
+    eval {
+	$get_challenge = xmlrpc_call("LJ.XMLRPC.getchallenge");
+	$challenge = $get_challenge->{'challenge'};
+	$response = md5_hex($challenge . md5_hex($dest_pass));
+    };
+    #Error handling
+    if ($@) {
+	print STDERR localtime(time) . ": Login on $dest_site failed\n";
+        print STDERR "debug2: " . $@;
+        print STDERR "\n\n";
+	die;
+    }
+
+    ($entry_date, $entry_time) = split(/ /,$entry->{'eventtime'});
+    ($year, $month, $day) = split(/-/,$entry_date);
+    ($hour, $min, $sec) = split(/:/,$entry_time);
+    #ëÏÐÉÒÕÅÍ × ÎÏ×ÕÀ ÚÁÐÉÓØ ÔÅ ÐÏÌÑ, ËÏÔÏÒÙÅ ÍÏÖÎÏ ÔÕÐÏ ÓËÏÐÉÒÏ×ÁÔØ
+    $fields = {
+	'username' => $dest_user,
+	'auth_method' => 'challenge',
+	'auth_challenge' => $challenge,
+	'auth_response' => $response,
+	'ver' => 1,
+	'subject' => ($entry->{'subject'})? 
+	              LJR::Viewuserstandalone::expand_ljuser_tags($entry->{'subject'})
+		       : "",
+	'year' => $year,
+	'mon' => $month,
+	'day' => $day,
+	'hour' => $hour,
+	'min' => $min,
+    };
+    #÷ÙÑÓÎÑÅÍ ÕÒÏ×ÅÎØ ÄÏÓÔÕÐÁ ËÏÐÉÒÕÅÍÏÊ ÚÁÐÉÓÉ
+    if (!$entry->{'security'}) {
+	 $fields->{'security'} = 'public';
+    } else {
+	$fields->{'security'} = $entry->{'security'};
+	if ($entry->{'allowmask'}) {
+	    $fields->{'allowmask'} = $entry->{'allowmask'};
+	}
+    };
+    #úÁÄÁ£Í ÓÔÒÏËÕ Ó ÍÅÔÁÄÁÎÎÙÍÉ
+    if ($entry->{'props'}->{'current_mood'})
+    {
+	$fields->{'props'}->{'current_mood'} = 
+	    $entry->{'props'}->{'current_mood'};
+    }
+    if ($entry->{'props'}->{'mood_id'})
+    {
+	$fields->{'props'}->{'mood_id'} =
+	    $entry->{'props'}->{'mood_id'};
+    }
+    if ($entry->{'props'}->{'current_music'})
+    {
+	$fields->{'props'}->{'current_music'} = 
+            $entry->{'props'}->{'current_music'};
+    }
+    if ($entry->{'props'}->{'opt_backdated'})
+    {
+	$fields->{'props'}->{'opt_backdated'} = 
+            $entry->{'props'}->{'opt_backdated'};
+    }
+
+    #úÁÐÒÅÝÁÅÍ ËÏÍÍÅÎÔÁÒÉÉ × ËÏÐÉÒÕÅÍÏÊ ÚÁÐÉÓÉ
+    $fields->{'props'}->{'opt_nocomments'} = 1;
+
+    #äÏÂÁ×ÌÑÅÍ Ë ÔÅËÓÔÕ ÚÁÐÉÓÉ ÓÓÙÌËÕ ÎÁ ËÏÍÍÅÎÔÁÒÉÉ × ÉÓÈÏÄÎÏÍ ÖÕÒÎÁÌÅ
+    my $talklink_line = "<div style=\"text-align:right\">".
+	               "<font size=\"-2\"><a href=\"".
+	               $entry->{'url'}.
+                       "\">Comments</a> | <a href=\"".
+                       $entry->{'url'}.
+                       "?mode=reply\">Comment on this</a></div>";
+    $fields->{'event'} = LJR::Viewuserstandalone::expand_ljuser_tags($entry->{'event'}).$talklink_line;
+    
+#    print STDERR "\n" . $fields->{'event'} . "\n";
+    
+    #ïÔÐÒÁ×ÌÑÅÍ ÏÞÅÒÅÄÎÕÀ ÚÁÐÉÓØ...
+    unless ($entry->{'props'}->{'revnum'}) {
+	eval {
+	    $postevent = xmlrpc_call('LJ.XMLRPC.postevent', $fields);
+	    #úÁÐÉÓÙ×ÁÅÍ ÓÏÏÔ×ÅÔÓÔ×ÉÅ ID ÉÓÈÏÄÎÏÇÏ ÐÏÓÔÉÎÇÁ É
+	    #ID ÏÔÇÅÊÔÏ×ÁÎÎÏÇÏ ÐÏÓÔÉÎÇÁ × ÔÁÂÌÉÃÕ rlj_lj_id
+	    $sqh = $dbh->prepare ("INSERT INTO rlj_lj_id(userid,ljr_id,lj_id)
+                                   VALUES ($user_id, 
+                                   $entry->{'itemid'},
+                                   $postevent->{'itemid'})");
+	    $sqh->execute;
+        };
+	#ïÂÒÁÂÏÔËÁ ÉÓËÌÀÞÅÎÉÑ: ÅÓÌÉ ÎÅ ÕÄÁÌÓÑ ×ÙÚÏ× XMLRPC
+        if ($@) {
+	    print STDERR localtime(time) . ": Posting event on $dest_site failed\n";
+            print STDERR "debug3: " . $@;
+            print STDERR "\n\n";
+        };
+
+    #...ÉÌÉ ÒÅÄÁËÔÉÒÕÅÍ Å£, ÅÓÌÉ ÏÎÁ ÉÍÅÅÔ ÎÅÎÕÌÅ×ÏÊ ÎÏÍÅÒ ÒÅ×ÉÚÉÉ
+    } else {
+	#éÝÅÍ × ÂÁÚÅ ID ÁÎÁÌÏÇÉÞÎÏÊ ÚÁÐÉÓÉ ÄÎÅ×ÎÉËÁ-ËÏÐÉÉ
+	$sqh = $dbh->prepare ("SELECT lj_id
+                               FROM rlj_lj_id
+                               WHERE userid=$user_id
+                                AND ljr_id=$entry->{'itemid'}");
+	$sqh->execute;
+
+	#ID ÚÁÐÉÓÉ × ÄÎÅ×ÎÉËÅ-ËÏÐÉÉ
+	my $lj_id;
+
+	#åÓÌÉ ÎÁÛÌÉ, ÒÅÄÁËÔÉÒÕÅÍ ÚÁÐÉÓØ Ó ÎÁÊÄÅÎÎÙÍ ID...
+	if (($lj_id) = $sqh->fetchrow_array) {
+	    $fields->{'itemid'} = $lj_id;
+	    eval {
+		$postevent = xmlrpc_call('LJ.XMLRPC.editevent', $fields);
+	    };
+	    #ïÂÒÁÂÏÔËÁ ÉÓËÌÀÞÉÔÅÌØÎÏÊ ÓÉÔÕÁÃÉÉ
+	    if ($@) {
+		print STDERR localtime(time) . ": Editing event on $dest_site failed\n";
+                print STDERR "debug4: " . $@;
+                print STDERR "\n\n";
+	    };
+	#...Á ÅÓÌÉ ÎÅÔ, ÓÒÁ×ÎÉ×ÁÅÍ Å£ ÄÁÔÕ
+	#Ó ÄÁÔÏÊ ÐÒÅÄÙÄÕÝÅÊ ÓÉÎÈÒÏÎÉÚÁÃÉÉ
+	} else {
+	    #åÓÌÉ ÚÁÐÉÓØ ÎÏ×ÁÑ, ÔÏ ÐÒÏÓÔÏ ÐÏÓÔÉÍ Å£...
+	    if (timelocal($ls_sec,$ls_min,$ls_hour,$ls_day,$ls_month,$ls_year)<
+		 timelocal($sec, $min, $hour, $day, $month, $year))
+	    {
+		eval {
+		    $postevent = xmlrpc_call('LJ.XMLRPC.postevent', $fields);
+		    #úÁÐÉÓÙ×ÁÅÍ ÓÏÏÔ×ÅÔÓÔ×ÉÅ ID ÉÓÈÏÄÎÏÇÏ ÐÏÓÔÉÎÇÁ É
+		    #ID ÏÔÇÅÊÔÏ×ÁÎÎÏÇÏ ÐÏÓÔÉÎÇÁ × ÔÁÂÌÉÃÕ rlj_lj_id
+		    $sqh = $dbh->prepare (
+				   "INSERT INTO rlj_lj_id(userid,ljr_id,lj_id)
+                                   VALUES ($user_id, 
+                                   $entry->{'itemid'},
+                                   $postevent->{'itemid'})");
+		    $sqh->execute;
+		};
+		#ïÂÒÁÂÏÔËÁ ÉÓËÌÀÞÅÎÉÑ: ÅÓÌÉ ÎÅ ÕÄÁÌÓÑ ×ÙÚÏ× XMLRPC
+		if ($@) {
+		    print STDERR localtime(time) . ": Posting event on $dest_site failed\n";
+                    print STDERR "debug5: " . $@;
+                    print STDERR "\n\n";
+		};
+	    #...ÉÎÁÞÅ ÐÏÓÔÉÍ Å£ Ó ÁÔÒÉÂÕÔÏÍ backdate
+	    } else {
+		$fields->{'props'}->{'opt_backdated'} = 1;
+		eval {
+		    $postevent = xmlrpc_call('LJ.XMLRPC.postevent', $fields);
+		    #úÁÐÉÓÙ×ÁÅÍ ÓÏÏÔ×ÅÔÓÔ×ÉÅ ID ÉÓÈÏÄÎÏÇÏ ÐÏÓÔÉÎÇÁ É
+		    #ID ÏÔÇÅÊÔÏ×ÁÎÎÏÇÏ ÐÏÓÔÉÎÇÁ × ÔÁÂÌÉÃÕ rlj_lj_id
+		    $sqh = $dbh->prepare (
+				   "INSERT INTO rlj_lj_id(userid,ljr_id,lj_id)
+                                   VALUES ($user_id, 
+                                   $entry->{'itemid'},
+                                   $postevent->{'itemid'})");
+		    $sqh->execute;
+		};
+		#ïÂÒÁÂÏÔËÁ ÉÓËÌÀÞÅÎÉÑ: ÅÓÌÉ ÎÅ ÕÄÁÌÓÑ ×ÙÚÏ× XMLRPC
+		if ($@) {
+		    print STDERR localtime(time) . ": Posting event on $dest_site failed\n";
+                    print STDERR "debug4: " . $@;
+                    print STDERR "\n\n";
+		};
+	    };
+	};
+    };
+  };
+};
+
+sub xmlrpc_call {
+    my ($method, $req) = @_;
+    my $res = $xmlrpc->call($method, $req);
+    if ($res && $res->fault) {
+        print STDERR "XML-RPC Error:\n".
+        " String: " . $res->faultstring . "\n" .
+        " Code: " . $res->faultcode . "\n";
+        die;
+    }
+    elsif (!$res) {
+        print STDERR "Unknown XML-RPC Error.\n";
+        die;
+    }
+    return $res->result;
+}

obsolete/cgi-bin/DBI/Role.pm.debug

@@ -0,0 +1,392 @@
+package DBI::Role;
+
+use 5.006;
+use strict;
+use warnings;
+BEGIN {
+    $DBI::Role::HAVE_HIRES = eval "use Time::HiRes (); 1;";
+}
+
+our $VERSION = '1.00';
+
+# $self contains:
+#
+#  DBINFO --- hashref.  keys = scalar roles, one of which must be 'master'.
+#             values contain DSN info, and 'role' => { 'role' => weight, 'role2' => weight }
+#
+#  DEFAULT_DB -- scalar string.  default db name if none in DSN hashref in DBINFO
+#
+#  DBREQCACHE -- cleared by clear_req_cache() on each request.
+#                fdsn -> dbh
+#
+#  DBCACHE -- role -> fdsn, or
+#             fdsn -> dbh
+#
+#  DBCACHE_UNTIL -- role -> unixtime
+#
+#  DB_USED_AT -- fdsn -> unixtime
+#
+#  DB_DEAD_UNTIL -- fdsn -> unixtime
+#
+#  TIME_CHECK -- if true, time between localhost and db are checked every TIME_CHECK
+#                seconds
+#
+#  TIME_REPORT -- coderef to pass dsn and dbtime to after a TIME_CHECK occurence
+
+sub new
+{
+    my ($class, $args) = @_;
+    my $self = {};
+    $self->{'DBINFO'} = $args->{'sources'};
+    $self->{'TIMEOUT'} = $args->{'timeout'};
+    $self->{'DEFAULT_DB'} = $args->{'default_db'};
+    $self->{'TIME_CHECK'} = $args->{'time_check'};
+    $self->{'TIME_LASTCHECK'} = {};  # dsn -> last check time
+    $self->{'TIME_REPORT'} = $args->{'time_report'};
+    bless $self, ref $class || $class;
+    return $self;
+}
+
+sub set_sources
+{
+    my ($self, $newval) = @_;
+    $self->{'DBINFO'} = $newval;
+    $self;
+}
+
+sub clear_req_cache
+{
+    my $self = shift;
+    $self->{'DBREQCACHE'} = {};
+}
+
+sub disconnect_all
+{
+    my ($self, $opts) = @_;
+    my %except;
+
+    if ($opts && $opts->{except} &&
+             ref $opts->{except} eq 'ARRAY') {
+        $except{$_} = 1 foreach @{$opts->{except}};
+    }
+
+    foreach my $cache (qw(DBREQCACHE DBCACHE)) {
+        next unless ref $self->{$cache} eq "HASH";
+        foreach my $key (keys %{$self->{$cache}}) {
+            next if $except{$key};
+            my $v = $self->{$cache}->{$key};
+            next unless ref $v eq "DBI::db";
+            $v->disconnect;
+            delete $self->{$cache}->{$key};
+        }
+    }
+    $self->{'DBCACHE'} = {};
+    $self->{'DBREQCACHE'} = {};
+}
+
+sub same_cached_handle
+{
+    my $self = shift;
+    my ($role_a, $role_b) = @_;
+    return
+        defined $self->{'DBCACHE'}->{$role_a} &&
+        defined $self->{'DBCACHE'}->{$role_b} &&
+        $self->{'DBCACHE'}->{$role_a} eq $self->{'DBCACHE'}->{$role_b};
+}
+
+sub flush_cache
+{
+    my $self = shift;
+    foreach (keys %{$self->{'DBCACHE'}}) {
+        my $v = $self->{'DBCACHE'}->{$_};
+        next unless ref $v;
+        $v->disconnect;
+    }
+    $self->{'DBCACHE'} = {};
+    $self->{'DBREQCACHE'} = {};
+}
+
+# old interface.  does nothing now.
+sub trigger_weight_reload
+{
+    my $self = shift;
+    return $self;
+}
+
+sub use_diff_db
+{
+    my $self = shift;
+    my ($role1, $role2) = @_;
+
+    return 0 if $role1 eq $role2;
+
+    # this is implied:  (makes logic below more readable by forcing it)
+    $self->{'DBINFO'}->{'master'}->{'role'}->{'master'} = 1;
+
+    foreach (keys %{$self->{'DBINFO'}}) {
+        next if /^_/;
+        next unless ref $self->{'DBINFO'}->{$_} eq "HASH";
+        if ($self->{'DBINFO'}->{$_}->{'role'}->{$role1} &&
+            $self->{'DBINFO'}->{$_}->{'role'}->{$role2}) {
+            return 0;
+        }
+    }
+    return 1;
+}
+
+sub get_dbh
+{
+    my $self = shift;
+    my $opts = ref $_[0] eq "HASH" ? shift : {};
+
+    my @roles = @_;
+    my $role = shift @roles;
+    return undef unless $role;
+
+    my $now = time();
+
+    # if 'nocache' flag is passed, clear caches now so we won't return
+    # a cached database handle later
+    $self->clear_req_cache if $opts->{'nocache'};
+
+    # otherwise, see if we have a role -> full DSN mapping already
+    my ($fdsn, $dbh);
+    if ($role eq "master") {
+        $fdsn = make_dbh_fdsn($self, $self->{'DBINFO'}->{'master'});
+    } else {
+        if ($self->{'DBCACHE'}->{$role} && ! $opts->{'unshared'}) {
+            $fdsn = $self->{'DBCACHE'}->{$role};
+            if ($now > $self->{'DBCACHE_UNTIL'}->{$role}) {
+                # this role -> DSN mapping is too old.  invalidate,
+                # and while we're at it, clean up any connections we have
+                # that are too idle.
+                undef $fdsn;
+
+                foreach (keys %{$self->{'DB_USED_AT'}}) {
+                    next if $self->{'DB_USED_AT'}->{$_} > $now - 60;
+                    delete $self->{'DB_USED_AT'}->{$_};
+                    delete $self->{'DBCACHE'}->{$_};
+                }
+            }
+        }
+    }
+
+    if ($fdsn) {
+        $dbh = get_dbh_conn($self, $fdsn, $role);
+        return $dbh if $dbh;
+        delete $self->{'DBCACHE'}->{$role};  # guess it was bogus
+    }
+    return undef if $role eq "master";  # no hope now
+
+    # time to randomly weightedly select one.
+    my @applicable;
+    my $total_weight;
+    foreach (keys %{$self->{'DBINFO'}}) {
+        next if /^_/;
+        next unless ref $self->{'DBINFO'}->{$_} eq "HASH";
+        my $weight = $self->{'DBINFO'}->{$_}->{'role'}->{$role};
+        next unless $weight;
+        push @applicable, [ $self->{'DBINFO'}->{$_}, $weight ];
+        $total_weight += $weight;
+    }
+
+    while (@applicable) {
+        my $rand = rand($total_weight);
+        my ($i, $t) = (0, 0);
+        for (; $i<@applicable; $i++) {
+            $t += $applicable[$i]->[1];
+            last if $t > $rand;
+        }
+        my $fdsn = make_dbh_fdsn($self, $applicable[$i]->[0]);
+        $dbh = get_dbh_conn($self, $opts, $fdsn);
+        if ($dbh) {
+            $self->{'DBCACHE'}->{$role} = $fdsn;
+            $self->{'DBCACHE_UNTIL'}->{$role} = $now + 5 + int(rand(10));
+            return $dbh;
+        }
+
+        # otherwise, discard that one.
+        $total_weight -= $applicable[$i]->[1];
+        splice(@applicable, $i, 1);
+    }
+
+    # try others
+    return get_dbh($self, $opts, @roles);
+}
+
+sub make_dbh_fdsn
+{
+    my $self = shift;
+    my $db = shift;   # hashref with DSN info
+    return $db->{'_fdsn'} if $db->{'_fdsn'};  # already made?
+
+    my $fdsn = "DBI:mysql";  # join("|",$dsn,$user,$pass) (because no refs as hash keys)
+    $db->{'dbname'} ||= $self->{'DEFAULT_DB'} if $self->{'DEFAULT_DB'};
+    $fdsn .= ":$db->{'dbname'}";
+    $fdsn .= ";host=$db->{'host'}" if $db->{'host'};
+    $fdsn .= ";port=$db->{'port'}" if $db->{'port'};
+    $fdsn .= ";mysql_socket=$db->{'sock'}" if $db->{'sock'};
+    $fdsn .= "|$db->{'user'}|$db->{'pass'}";
+
+    $db->{'_fdsn'} = $fdsn;
+    return $fdsn;
+}
+
+sub get_dbh_conn
+{
+    my $self = shift;
+    my $opts = ref $_[0] eq "HASH" ? shift : {};
+    my $fdsn = shift;
+    my $role = shift;  # optional.
+    my $now = time();
+
+    my $retdb = sub {
+        my $db = shift;
+        $self->{'DBREQCACHE'}->{$fdsn} = $db;
+        $self->{'DB_USED_AT'}->{$fdsn} = $now;
+        return $db;
+    };
+
+    # have we already created or verified a handle this request for this DSN?
+    return $retdb->($self->{'DBREQCACHE'}->{$fdsn})
+        if $self->{'DBREQCACHE'}->{$fdsn} && ! $opts->{'unshared'};
+
+    # check to see if we recently tried to connect to that dead server
+    return undef if $self->{'DB_DEAD_UNTIL'}->{$fdsn} && $now < $self->{'DB_DEAD_UNTIL'}->{$fdsn};
+
+    # if not, we'll try to find one we used sometime in this process lifetime
+    my $dbh = $self->{'DBCACHE'}->{$fdsn};
+
+    # if it exists, verify it's still alive and return it.  (but not
+    # if we're wanting an unshared connection)
+    if ($dbh && ! $opts->{'unshared'}) {
+#	return $retdb->($dbh) unless connection_bad($dbh, $opts);
+	undef $dbh;
+	undef $self->{'DBCACHE'}->{$fdsn};
+    }
+
+    # time to make one!
+    my ($dsn, $user, $pass) = split(/\|/, $fdsn);
+    my $timeout = $self->{'TIMEOUT'} || 2;
+    $dsn .= ";mysql_connect_timeout=$timeout";
+
+    my $loop = 1;
+    my $tries = $DBI::Role::HAVE_HIRES ? 8 : 2;
+    while ($loop) {
+        $loop = 0;
+        $dbh = DBI->connect($dsn, $user, $pass, {
+            PrintError => 1,
+            AutoCommit => 1,
+        });
+
+        # if max connections, try again shortly.
+        if (! $dbh && $DBI::err == 1040 && $tries) {
+            $tries--;
+            $loop = 1;
+            if ($DBI::Role::HAVE_HIRES) {
+                Time::HiRes::usleep(250_000);
+            } else {
+                sleep 1;
+            }
+        }
+    }
+
+    my $DBI_err = $DBI::err || 0;
+
+    # check replication/busy processes... see if we should not use 
+    # this one
+#    undef $dbh if connection_bad($dbh, $opts);
+
+    # if this is an unshared connection, we don't want to put it
+    # in the cache for somebody else to use later. (which happens below)
+    return $dbh if $opts->{'unshared'};
+
+    # mark server as dead if dead.  won't try to reconnect again for 5 seconds.
+    if ($dbh) {
+        $self->{'DB_USED_AT'}->{$fdsn} = $now;
+
+        if ($self->{'TIME_CHECK'} && ref $self->{'TIME_REPORT'} eq "CODE") {
+            my $now = time();
+            $self->{'TIME_LASTCHECK'}->{$dsn} ||= 0;  # avoid warnings
+            if ($self->{'TIME_LASTCHECK'}->{$dsn} < $now - $self->{'TIME_CHECK'}) {
+                $self->{'TIME_LASTCHECK'}->{$dsn} = $now;
+                my $db_time = $dbh->selectrow_array("SELECT UNIX_TIMESTAMP()");
+                $self->{'TIME_REPORT'}->($dsn, $db_time, $now);
+            }
+        }
+    } else {
+        # mark the database as dead for a bit, unless it was just because of max connections
+        $self->{'DB_DEAD_UNTIL'}->{$fdsn} = $now + 5
+            unless $DBI_err == 1040;
+    }
+
+    return $self->{'DBREQCACHE'}->{$fdsn} = $self->{'DBCACHE'}->{$fdsn} = $dbh;
+}
+
+sub connection_bad {
+    my ($dbh, $opts) = @_;
+
+    return 1 unless $dbh;
+
+    my $ss = eval {
+        $dbh->selectrow_hashref("SHOW SLAVE STATUS");
+    };
+
+    # if there was an error, and it wasn't a permission problem (1227)
+    # then treat this connection as bogus
+    if ($dbh->err && $dbh->err != 1227) {
+	return 1;
+    }
+
+    # connection is good if $ss is undef (not a slave)
+    return 0 unless $ss;
+
+    # otherwise, it's okay if not MySQL 4
+    return 0 if ! $ss->{'Master_Log_File'} || ! $ss->{'Relay_Master_Log_File'};
+
+    # all good if within 100 k
+    if ($opts->{'max_repl_lag'}) {
+	return 0 if
+	    $ss->{'Master_Log_File'} eq $ss->{'Relay_Master_Log_File'} &&
+	    ($ss->{'Read_Master_Log_Pos'} - $ss->{'Exec_master_log_pos'}) < $opts->{'max_repl_lag'};
+
+	# guess we're behind
+	return 1;
+    } else {
+	# default to assuming it's good
+	return 0;
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+DBI::Role - Get DBI cached handles by role, with weighting & failover.
+
+=head1 SYNOPSIS
+
+  use DBI::Role;
+  my $DBIRole = new DBI::Role {
+    'sources' => \%DBINFO,
+    'default_db' => "somedbname", # opt.
+  };
+  my $dbh = $DBIRole->get_dbh("master");
+
+=head1 DESCRIPTION
+
+To be written.
+
+=head2 EXPORT
+
+None by default.
+
+=head1 AUTHOR
+
+Brad Fitzparick, E<lt>brad@danga.comE<gt>
+
+=head1 SEE ALSO
+
+L<DBI>.
+

obsolete/cgi-bin/LJ/Rewriteuser.pm

@@ -0,0 +1,133 @@
+# Package that handles redirects of the form:
+# http://[sitename]/users/name1/[digits].html[anything else] =>
+#   http://[sitename]/users/name2/[digits].html[anything else]
+#      if digits < maxid 
+# Maxid is a prescribed number, name 1 and name 2 are prescribd usernames.
+# The same works for http://[sitename]/~name1/...
+# name 2 must be an existing users
+#
+# How it works:
+# all processing of *.html passes through Apache::Livejournal::trans
+# A hook has been added to that function that calls 
+# LJ:Rewriteuser::uri_check, then uri_rew
+# The list of known redirects is kept in a table "rewriteusers" in
+# the livejournal database; this package also provides functions
+# to work with this table in a safe way.
+#
+# Additionally, the part in LJ::alloc_user_counter which gives id to
+# new entries has been modified in the following way: instead of
+# taking max of all the existing entries, it now checks whether we
+# have a redirect in the table, and if "yes", takes max of all
+# existing entries and maxid from redirect table
+#
+# Table structure:
+#+----------+------------------+------+-----+---------+-------+
+#| Field    | Type             | Null | Key | Default | Extra |
+#+----------+------------------+------+-----+---------+-------+
+#| fromuser | char(15)         |      | PRI |         |       |
+#| touser   | char(15)         |      |     |         |       |
+#| maxid    | int(10) unsigned |      |     | 0       |       |
+#+----------+------------------+------+-----+---------+-------+
+
+
+package LJ::Rewriteuser;
+
+use strict;
+
+use Carp;                                                                                                                
+use lib "$ENV{'LJHOME'}/cgi-bin";                                                                                        
+use DBI;                                                                                                                 
+use DBI::Role;                                                                                                           
+use DBIx::StateKeeper;
+#use LJ;
+
+my %REWRITE=();
+
+# Check whether uri needs to be rewritten
+
+sub uri_check {
+    my ($uri)=@_;
+
+# Scan the redirect table to see whether username matches
+
+    foreach my $rwuser (keys %REWRITE){
+	if ($uri =~ m|users/$rwuser/(\d+)|i) {if($1 < $REWRITE{$rwuser}{'maxnum'}){ return 1;}}
+	if ($uri =~ m|~$rwuser/(\d+).html|i) {if($1 < $REWRITE{$rwuser}{'maxnum'}){ return 1;}}
+	if ($uri =~ m|community/$rwuser/(\d+).html|i) {if($1 < $REWRITE{$rwuser}{'maxnum'}){ return 1;}}
+    }
+    return 0;
+}
+
+# Rewrite uri (if it's needed -- if not, return the intact original)
+
+sub uri_rew {
+    my ($uri)=@_;
+    if(uri_check($uri)){
+	foreach my $rwuser (keys %REWRITE){
+		foreach my $type ("~","users/","community/"){
+			my $to=$type.$rwuser;
+			my $from=$type.$REWRITE{$rwuser}{'newname'};
+			$uri =~ s|$to|$from|i;
+		}
+	}
+    }
+    return $uri;
+}
+
+# Check the database for redirects, and if yes, return maxid (to
+# give it to LJ:alloc_user_counter). If not, return 0.
+
+sub get_min_jid {
+    my ($journalid)= @_;
+    my $user=LJ::get_username($journalid);
+    foreach my $rwuser (keys %REWRITE){
+	if ($rwuser eq $user){
+	    return ($REWRITE{$rwuser}{'maxnum'} / 256)+1;
+	}
+    }
+    return 0;
+}
+
+# Check whether there is a redirect from name1, if yes, return
+# name2, if not, return 0
+
+sub get_rewrite {
+    my ($fromuser)= @_;
+    if($REWRITE{$fromuser}) {return $REWRITE{$fromuser}{'newname'};}
+    else {return 0;}
+}
+
+# The function to init the redirect table in the database during
+# httpd restart
+
+sub init {
+	my $dbh = LJ::get_db_writer();
+        my $sth = $dbh->prepare("SELECT fromuser, touser, maxid FROM rewriteusers");                    
+        $sth->execute;                                                                                                   
+        while (my ($from, $to, $maxid) = $sth->fetchrow_array) {                                                              
+	    $REWRITE{$from}{'newname'}=$to;
+	    $REWRITE{$from}{'maxnum'}=$maxid;
+        }                            
+}
+
+# Remove a redirect from the table
+
+sub delete_rewrite_hash{
+	my ($fromuser) = @_;
+	delete($REWRITE{$fromuser});
+	my $dbh = LJ::get_db_writer();
+	$dbh->do("DELETE FROM rewriteusers WHERE fromuser = ?", undef, $fromuser);
+}
+
+# Add a redirect to the table
+
+sub insert_rewrite_hash{
+	my ($from, $to, $maxid) =@_;
+        $REWRITE{$from}{'newname'}=$to;                                                                                           
+        $REWRITE{$from}{'maxnum'}=$maxid; 
+	my $dbh = LJ::get_db_writer();
+	$dbh->do("INSERT INTO rewriteusers VALUES (?, ?, ?)", undef, $from, $to, $maxid);
+}
+init();
+
+1;

obsolete/htdocs/admin/redirectusers.bml

@@ -0,0 +1,113 @@
+<html>                                                                                                                                
+<head><title>Redirect users</title></head>                                                                                             
+<body>                                                                                                                                
+<?_code
+{
+    use strict;
+    use vars qw($title $body %GET %POST);
+    use LJ::Rewriteuser;
+
+    $title = "Redirect users";
+    $body = "";
+    
+    # login check
+    my $remote = LJ::get_remote();
+    
+        return LJ::bad_input("You must be logged in to modify your journal")                                                              
+	        unless $remote;
+    
+    # priv check
+        return LJ::bad_input("You do not have the necessary privilege to be here.") 
+	    unless LJ::check_priv($remote, 'admin');                                                              
+
+    # Subroutine that provides the HTML form
+
+ my $update_form = sub {
+     my $ret;
+
+     $ret .= "<form action='redirectusers.bml' method='post'>\n";
+     $ret .= LJ::html_hidden(mode => 'submit',
+                              ssl => $GET{'ssl'});
+
+     $ret .= "<?h1 Redirect users h1?>\n";
+     $ret .= "<?p To redirect a user or a community, fill out the form below p?>\n";
+
+     $ret .= "<?standout\n";
+     $ret .= "Redirect from:<br />\n";
+     $ret .= "<input name='from' size='30' maxlength='15'/><br />\n";
+     $ret .= "Redirect to:<br />\n";
+     $ret .= "<input name='to' size='30' maxlength='15' /><br />\n";
+     $ret .= "Affect entries with numbers strictly less than:<br />\n";
+     $ret .= "<input name='maxid' size='30' maxlength='15' /><br />\n";
+     $ret .= "standout?>\n";
+
+     $ret .= "<?h1 Proceed h1?>\n";
+     $ret .= "<?p Press the button to turn on redirect. Should work for communities, too. To remove redirect, leave the &quot;Redirect to:&quot; field empty. p?>\n";
+
+     $ret .= "<?standout\n";
+     $ret .= "<input type='submit' value='Proceed' />\n";
+     $ret .= "standout?>\n";
+     $ret .= "</form>\n";
+     return $ret;
+};
+
+# If POST didn't accur, give out the HTML form. If it did occur,
+# process data
+
+ unless (LJ::did_post()) {
+     $body .= $update_form->();
+
+# Redirect from 'from' to 'to' with maxid 'maxid' 
+
+ } elsif ($POST{'mode'} eq 'submit') {
+
+# Get $from, $to, $maxid, canonicalize $from and $to.
+
+     my $from = LJ::canonical_username($POST{'from'});
+     my $to = LJ::canonical_username($POST{'to'});
+     my $maxid = $POST{'maxid'};
+     
+# If $to not emptry, we're adding a redirect
+
+         if ($to ne "") {
+
+# Check whether maxidx is an integer
+
+	     if($maxid =~ /\d+/){
+	    	$maxid=$maxid+0;
+
+# Check whether we already have a redirect from $from
+
+		if (!(LJ::Rewriteuser::get_rewrite($from))){
+
+# We don't have a redirect -- okay, we add it
+
+		    LJ::Rewriteuser::insert_rewrite_hash($from,$to,$maxid);
+		    $body = "Success: $from is now redirected to $to with maxid $maxid.<br>Please restart httpd before setting any oy other redirects.";
+
+# We do have redirect already -- do nothing, return error
+
+		} else {$body = "Error: there already is a redirect for this user. Namely, to: ".(LJ::Rewriteuser::get_rewrite($from));}
+
+# maxid is not an integer -- return error
+
+	    } else {$body="Error: maxid must be a number.";}
+
+# Okay, $to is empty -- this means we're removing a redirect
+
+         } else { 
+	    if (LJ::Rewriteuser::get_rewrite($from)){
+		LJ::Rewriteuser::delete_rewrite_hash($from);
+		$body="Success: $from is not redirected anywhere from now on. <br>Please restart httpd before setting any oy other redirects.";
+	    }
+	}
+    } 
+    return $body;
+}
+_code?>                                                                                                                               
+</body>                                                                                                                               
+</html>                                                                                                                               
+<?_c <LJDEP>                                                                                                                          
+lib: cgi-bin/console.pl, cgi-bin/ljlib.pl                                                                                             
+</LJDEP> _c?> 
+

obsolete/htdocs/lj-gate/index.bml

@@ -0,0 +1,14 @@
+<?page
+title=>Live LJR to LJ export.
+body<=
+<?h1 Welcome! h1?>
+<?p
+Here you can <a href="rlj2lj.bml">create or change</a> lj-gate or <a href="rlj_delete.bml">delete the gate</a>.
+p?>
+
+<?p
+<a href="lj-gate-faq.html">LJ-gate FAQ</a>
+p?>
+
+<=body
+page?>

obsolete/htdocs/lj-gate/rlj2lj.bml

@@ -0,0 +1,144 @@
+<?_info
+nocache=>1
+_info?>
+<?page
+title=><?_ml .title _ml?>
+body<=
+<?h1 Update LJR -> LJ live export parameters. h1?>
+<br/>
+<?_code
+  use strict;
+  use DBI;
+  use vars qw(%POST);
+  use XMLRPC::Lite;
+  use Digest::MD5 qw(md5_hex); 
+
+  my $ret;
+
+  # copied from update.bml
+  if ($LJ::SERVER_DOWN) {
+    return LJ::server_down_html();
+  }
+  my $remote = LJ::get_remote();
+  # Errors that are unlikely to change between starting
+  # to compose an entry and submitting it.
+  if ($remote) {
+    if ($remote->underage) {
+      return BML::redirect("$LJ::SITEROOT/agecheck/?s=1");
+    }
+    if ($remote->identity) {
+      return "Non-$LJ::SITENAME users can't post, as they don't actually have journals here.\n";
+    }
+    if (! LJ::get_cap($remote, "can_post")) {
+      return $LJ::MSG_NO_POST || $ML{'.error.cantpost'};
+    }
+  }
+  else {
+    return "Please login.\n";
+  }
+
+  my $qhost = $LJ::DBINFO{'master'}->{'host'};
+  my $quser = $LJ::DBINFO{'master'}->{'user'};
+  my $qpass = $LJ::DBINFO{'master'}->{'pass'};
+  my $qsock = $LJ::DBINFO{'master'}->{'sock'};
+  my $qport = $LJ::DBINFO{'master'}->{'port'};
+  #my $qdb = $LJ::DBINFO{'master'}->{'dbname'};
+  my $qdb = "prod_ljgate";
+
+  my $alien=$POST{'alien'};
+  my $alienpass=$POST{'alienpass'};
+
+  my $mode=$POST{'mode'};
+
+  my $xmlrpc;
+  my $get_chal;
+  my $chal;
+  my $response;
+  my $login;
+
+  #åÓÌÉ ÎÁÍ ÕÖÅ ÐÅÒÅÄÁÌÉ ÐÁÒÁÍÅÔÒÙ, ÄÏÂÁ×ÌÑÅÍ ÐÏÌØÚÏ×ÁÔÅÌÅÊ...
+  if ($mode eq "add") {
+    $xmlrpc = new XMLRPC::Lite;
+    $xmlrpc->proxy("http://www.livejournal.com/interface/xmlrpc");
+    $get_chal = $xmlrpc->call("LJ.XMLRPC.getchallenge");
+    $chal = $get_chal->result->{'challenge'};
+    $response = md5_hex($chal . md5_hex($alienpass));
+    $login = $xmlrpc->call('LJ.XMLRPC.login', {
+      'username' => $alien,
+      'auth_method' => 'challenge',
+      'auth_challenge' => $chal,
+      'auth_response' => $response,
+      });
+      
+    if($login->fault){
+      $ret .= "Got error: " . $login->faultstring . "<br>";
+      $ret .= "<a href=rlj2lj.bml>Retry.</a>";
+      return $ret;
+    }
+
+    #ó×ÑÚÙ×ÁÅÍÓÑ Ó ÂÁÚÏÊ
+    my $dbh = DBI->connect(
+      "DBI:mysql:mysql_socket=$qsock;hostname=$qhost;port=$qport;database=$qdb",
+      $quser, $qpass,
+      ) || die  localtime(time) . ": Can't connect to database\n";
+    my $sqh;
+
+    $sqh = $dbh->prepare("delete from our_user where our_user = ?");
+    $sqh->execute($remote->{'user'});
+
+    $sqh = $dbh->prepare("insert INTO our_user (our_user,our_pass) VALUES(?, ?)");
+    $sqh->execute($remote->{'user'}, $remote->{'password'});
+
+    $sqh = $dbh->prepare("INSERT INTO alien (alien,alienpass) VALUES(?, ?)");
+    $sqh->execute($alien, $alienpass);
+
+    #õÚÎÁ£Í ID Ó×ÅÖÅÄÏÂÁ×ÌÅÎÎÙÈ ÐÏÌØÚÏ×ÁÔÅÌÅÊ
+    #...ÎÁ Ó×Ï£Í ÓÅÒ×ÅÒÅ
+    $sqh = $dbh->prepare("SELECT userid FROM our_user WHERE our_user=?");
+    $sqh->execute($remote->{'user'});
+
+    my $userid=$sqh->fetchrow_array;
+
+    #...É ÎÁ ÞÕÖÏÍ
+    $sqh = $dbh->prepare("SELECT alienid FROM alien WHERE alien=?");
+    $sqh->execute($alien);
+
+    my $alienid=$sqh->fetchrow_array;
+
+    #äÏÂÁ×ÌÑÅÍ ÎÏ×ÕÀ ÚÁÐÉÓØ × ÔÁÂÌÉÃÕ ÖÕÒÎÁÌÏ×,
+    #ËÏÔÏÒÙÅ ËÏÐÉÒÕÀÔÓÑ Ó ÎÁÛÅÇÏ ÓÅÒ×ÅÒÁ ×Ï×ÎÅ
+    $sqh = $dbh->prepare("INSERT INTO rlj2lj(userid,alienid) VALUES (?,?)");
+    $sqh->execute($userid, $alienid);
+
+    $ret .= "<br/>Export parameters updated:&nbsp;";
+    $ret .= "<a href=http://lj.rossia.org/users/$remote->{'user'}>$remote->{'user'}</a> is exported to <a href=http://www.livejournal.com/users/$alien>$alien</a>.";
+    $ret .= "<br/><br/><a href=/lj-gate/>LJ-gate root</a>";
+
+    $dbh->disconnect;
+
+  } else {
+    $ret .= "<form method=\"post\" action=\"rlj2lj.bml\">\n";
+    $ret .= LJ::html_hidden(mode => 'add');
+    $ret .= "<br>";
+    $ret .= "<b>Livejournal.com</b><br>";
+    $ret .= "<div class='formitemDesc'>" . BML::ml('Username') . "</div>";
+    $ret .= LJ::html_text({'name' => 'alien',
+       'size' => 15,
+       'maxlength' => 15,
+        });
+    $ret .= "<div class='formitemDesc'>" . BML::ml('Password') . "</div>";
+    $ret .= LJ::html_text({'name' => 'alienpass',
+         'size' => 30,
+         'maxlength' => 31,
+         'type' => "password",});
+    $ret .= "<br>";
+    $ret .=  LJ::html_submit('confirm', $ML{'.confirm.submit'});
+    $ret .= "</form>\n";
+  };
+ 
+  return $ret;
+
+_code?>
+
+<=body
+page?>

obsolete/htdocs/lj-gate/rlj_delete.bml

@@ -0,0 +1,104 @@
+<?_info
+nocache=>1
+_info?>
+<?page
+title=><?_ml .title _ml?>
+body<=
+<?h1 Remove LJR -> LJ live export. h1?>
+<br/>
+<?_code
+  use strict;
+  use DBI;
+  use vars qw(%POST);
+
+  # copied from update.bml
+  if ($LJ::SERVER_DOWN) {
+    return LJ::server_down_html();
+  }
+  my $remote = LJ::get_remote();
+  # Errors that are unlikely to change between starting
+  # to compose an entry and submitting it.
+  if ($remote) {
+    if ($remote->underage) {
+      return BML::redirect("$LJ::SITEROOT/agecheck/?s=1");
+    }
+    if ($remote->identity) {
+      return "Non-$LJ::SITENAME users can't post, as they don't actually have journals here.\n";
+    }
+    if (! LJ::get_cap($remote, "can_post")) {
+      return $LJ::MSG_NO_POST || $ML{'.error.cantpost'};
+    }
+  }
+  else {
+    return "Please login.\n";
+  }
+
+  my $qhost = $LJ::DBINFO{'master'}->{'host'};
+  my $quser = $LJ::DBINFO{'master'}->{'user'};
+  my $qpass = $LJ::DBINFO{'master'}->{'pass'};
+  my $qsock = $LJ::DBINFO{'master'}->{'sock'};
+  my $qport = $LJ::DBINFO{'master'}->{'port'};
+  #my $qdb = $LJ::DBINFO{'master'}->{'dbname'};
+  my $qdb = "prod_ljgate";
+
+  my $dbh = DBI->connect(
+    "DBI:mysql:mysql_socket=$qsock;hostname=$qhost;port=$qport;database=$qdb",
+    $quser, $qpass,
+    ) || die  localtime(time) . ": Can't connect to database\n";
+  my $sqh;
+
+  #ID ÕÄÁÌÑÅÍÏÇÏ ÐÏÌØÚÏ×ÁÔÅÌÑ LJR
+  my $user_id;
+  #ID ÕÄÁÌÑÅÍÏÇÏ ÐÏÌØÚÏ×ÁÔÅÌÑ LiveJournal
+  my $alien_id;
+
+  #÷Ù×ÏÄÉÍ ÆÏÒÍÕ ÉÌÉ ÄÏÂÁ×ÌÑÅÍ ÐÏÌØÚÏ×ÁÔÅÌÑ × ÂÁÚÕ?
+  my $mode=$POST{'mode'};
+
+  #÷Ù×ÏÄ
+  my $ret;
+
+  #åÓÌÉ ÎÁÍ ÕÖÅ ÐÅÒÅÄÁÌÉ ÐÁÒÁÍÅÔÒÙ, ÕÄÁÌÑÅÍ ÐÏÌØÚÏ×ÁÔÅÌÑ...
+  if ($mode eq "del") {
+    #úÁÂÉÒÁÅÍ ÉÚ ÔÁÂÌÉÃÙ our_user ID, ÌÏÇÉÎ É ÐÁÒÏÌØ ÕÄÁÌÑÅÍÏÇÏ ÐÏÌØÚÏ×ÁÔÅÌÑ
+    my $sqh=$dbh->prepare("SELECT userid FROM our_user WHERE our_user=?");
+    $sqh->execute($remote->{'user'});
+    $user_id = $sqh->fetchrow_array;
+  
+    #úÁÂÉÒÁÅÍ ÉÚ ÔÁÂÌÉÃÙ rlj2lj ID ÐÏÌØÚÏ×ÁÔÅÌÑ ÞÕÖÏÇÏ ÒÅÓÕÒÓÁ
+    $sqh = $dbh->prepare("SELECT alienid FROM rlj2lj WHERE userid=?");
+    $sqh->execute ($user_id);
+    $alien_id = $sqh->fetchrow_array;
+   
+    #õÄÁÌÑÅÍ ÚÁÐÉÓØ ÉÚ ÔÁÂÌÉÃÙ rlj2lj
+    $sqh = $dbh->prepare("DELETE FROM rlj2lj WHERE userid=?");
+    $sqh->execute($user_id);
+   
+    #õÄÁÌÑÅÍ ÄÁÎÎÙÅ Ï ÞÕÖÏÍ ÐÏÌØÚÏ×ÁÔÅÌÅ
+    $sqh = $dbh->prepare("DELETE FROM alien WHERE alienid=?");
+    $sqh->execute($alien_id);
+
+    #õÄÁÌÑÅÍ ÄÁÎÎÙÅ Ï ÎÁÛÅÍ ÐÏÌØÚÏ×ÁÔÅÌÅ
+    $sqh = $dbh->prepare("DELETE FROM our_user WHERE userid=?");
+    $sqh->execute($user_id);
+
+    #õÄÁÌÑÅÍ ÄÁÎÎÙÅ Ï ÐÏÓÔÉÎÇÁÈ        
+    $sqh = $dbh->prepare("DELETE FROM rlj_lj_id WHERE userid=?");
+    $sqh->execute($user_id);
+
+    $ret .= "<br/>Live LJR -> LJ export removed.";
+    $ret .= "<br/><br/><a href=/lj-gate/>LJ-gate root</a>";
+  }
+  #...× ÐÒÏÔÉ×ÎÏÍ ÓÌÕÞÁÅ ×Ù×ÏÄÉÍ ÆÏÒÍÕ
+  else {
+     $ret .= "<form method=\"post\" action=\"rlj_delete.bml\">\n";
+     $ret .= LJ::html_hidden(mode => 'del');
+     $ret .= LJ::html_submit('confirm', 'Remove export!');
+  };
+ 
+  $dbh->disconnect;
+  return $ret;
+
+_code?>
+<=body
+page?>

obsolete/htdocs/paidaccounts/index.html

@@ -0,0 +1,10 @@
+<title>Paid Accounts</title>
+<META content="text/html; charset=koi8-r" http-equiv=Content-Type>
+
+<h2>Мы работаем над этим!!</h2>
+
+<p>Пока что система оплаты не налажена -- мы не можем ни принимать
+деньги за платные аккаунты, ни принимать ваши пожертвования на
+развитие и поддержку сервеа. Но мы работаем над этим; следите за
+новостями.
+