🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: es.comp.os.linux.programacion
Article #11805

Re: Perl + database + quitar "par"

#11805
From: Jesús Carrete Montaña
Date: Sun, 07 Oct 2001 20:26
230 lines
7902 bytes
--=-=-=
Content-Type: text/plain; charset=iso-8859-1
Content-Transfer-Encoding: 8bit

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

>>>>> "marmolejo" == marmolejo  <marmolejo@escomposlinux.org> writes:

    marmolejo> Hola, este script genera archivos database.dir y
    marmolejo> database.pag con parejas usarios/password...�alguien
    marmolejo> puede decirme c�mo conseguir que se puedan tambi�n
    marmolejo> quitar parejas de usuario/pass?

        A petici�n de Antonio en el IRC he hecho un script en perl
para realizar las operaciones b�sicas sobre ese tipo de bases de datos
de INN2. Lo adjunto, aunque no es gran cosa ni est� muy probado.

Un saludo.
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.0.6 (GNU/Linux)
Comment: Processed by Mailcrypt 3.5.6 and Gnu Privacy Guard <http://www.gnupg.org/>

iD8DBQE7wLpffUtQQKOnZ1IRAi9cAKDoPmyUufj3KriMpaM68+qyTReMgQCgrRSg
nmcRuFEShBM/eyraN+dF4lk=
=zmqZ
-----END PGP SIGNATURE-----


--=-=-=
Content-Type: application/x-perl
Content-Disposition: attachment; filename=inn2db.pl
Content-Transfer-Encoding: quoted-printable

#!/usr/bin/perl

use warnings;

# Cadenas de informaci=F3n sobre licencia y ayuda.
my $CopyLeft=3D'
  inn2db, maneja la bases de datos de usuarios y passwords de inn2.
  Copyright (C) 2001 Jes=FAs Carrete Monta=F1a <kuantiko@escomposlinux.org>

  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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

';

my $Help=3D"
Comandos v=E1lidos:
   open   <ruta>                : abre una base de datos. Si no existe,
                                  crea una nueva.
   close                        : cierra la base de datos abierta,
                                  guardando su contenido.
   list                         : muestra el contenido actual de la
                                  base de datos abierta.
   add    <nombre> <clave>      : a=F1ade un usuario con su correspondiente
                                  clave a la base de datos.
   delete <nombre>              : borra un usuario de la base de datos
   verify <nombre> <clave>      : comprueba si el password proporcionado.
                                  coincide con el almacenado en la base
                                  de datos.
   quit                         : sale del programa.
   help                         : muestra esta ayuda.

";

# Cargamos los m=F3dulos necesarios.
use Fcntl;
use NDBM_File;

# Sacamos por pantalla la informaci=F3n de copyleft.
print($CopyLeft);

# 1 si hay una base de datos abierta, 0 si no.
my($Open)=3D0;
# Hash representando la base de datos.
my(%DB);

# Salva la base de datos si procede.
sub Clean{
    # Cerramos la base de datos si est=E1 abierta.
    untie(%DB) if($Open);
}

# En caso de muerte por SIGINT intentamos salvar la base de datos.
$SIG{INT}=3DClean;

for(;;){
    # Mostramos la l=EDnea de introducci=F3n de comandos.
    print("inn2db> ");
    # Leemos una l=EDnea de entrada.
    my($Line)=3D"";
    for(;;){
	$C=3Dgetc(STDIN);
	last if($C eq "\n");
	last if(eof(STDIN));
	$Line.=3D$C;
    }
    # La partimos en palabras, despreciando los campos vac=EDos.
    my(@Words)=3Dgrep(!/\s+/,split(/\s+/,$Line));
    if(!scalar(@Words)){
	print "\n";
	next;
    }
    # Examinamos la primera palabra para ver si se trata de un comando.
    if($Words[0] eq "open"){
	if(scalar(@Words)!=3D2){
	    print("Uso: open <ruta>\n");
	}else{
	    if(!$Open){
		# Intentamos abrir la base de datos.
		if(tie(%DB,"NDBM_File",$Words[1],O_RDWR|O_CREAT,0666)){
		    $Open=3D1;
		}else{
		    print("No se pudo abrir el archivo:\n$!\n");
		}
	    }else{
		print("Ya hay una base de datos abierta. Ci=E9rrela primero.\n");
	    }
	}
    }elsif($Words[0] eq "close"){
	if(scalar(@Words)!=3D1){
	    print("Uso: close\n");
	}else{
	    if(!$Open){
		print("No hay ninguna base de datos abierta.\n");
	    }else{
		untie(%DB);
		$Open=3D0;
	    }
	}
    }elsif($Words[0] eq "list"){
	if(scalar(@Words)!=3D1){
	    print("Uso: list\n");
	}else{
	    if(!$Open){
		print("No hay ninguna base de datos abierta.\n");
	    }else{
		print("Nombre                         Clave\n");
		print("---------------------------------------\n");
		foreach $Key (keys(%DB)){
		    print(sprintf("%-30s %-30s\n",$Key,$DB{$Key}));
		}
	    }
	}
    }elsif($Words[0] eq "add"){
	if(scalar(@Words)!=3D3){
	    print("Uso: add <nombre> <clave>");
	}else{
	    if(!$Open){
		print("No hay ninguna base de datos abierta.\n");
	    }else{
		if(defined $DB{$Words[1]}){
		    printf("Ya existe un usuario con ese nombre.\n");
		}else{
		    # Ciframos la clave.
		    my(@Alphabet)=3D('.','/',0..9,'A'..'Z','a'..'z');
		    my($Salt)=3Djoin('',@Alphabet[rand(64),rand(64)]);
		    # Y a=F1adimos el registro.
		    $DB{$Words[1]}=3Dcrypt($Words[2],$Salt);
		}
	    }
	}
    }elsif($Words[0] eq "delete"){
	if(scalar(@Words)!=3D2){
	    print("Uso: delete <nombre>");
	}else{
	    if(!$Open){
		print("No hay ninguna base de datos abierta.\n");
	    }else{
		if(defined $DB{$Words[1]}){
		    delete($DB{$Words[1]});
		}else{
		    printf("No existe un registro con el nombre indicado.\n");
		}
	    }
	}
    }elsif($Words[0] eq "verify"){
	if(scalar(@Words)!=3D3){
	    print("Uso: verify <nombre> <clave>");
	}else{
	    if(!$Open){
		print("No hay ninguna base de datos abierta.\n");
	    }else{
		if(defined $DB{$Words[1]}){
		    my($Salt)=3Dsubstr($DB{$Words[1]},0,2);
		    if(crypt($Words[2],$Salt) eq $DB{$Words[1]}){
			print("Coincide.\n");
		    }else{
			print("No coincide.\n");
		    }
		}else{
		    printf("No existe un registro con el nombre indicado.\n");
		}
	    }
	}
    }elsif($Words[0] eq "quit"){
	if(scalar(@Words)!=3D1){
	    print("Uso: quit\n");
	}else{
	    last;
	}
    }elsif($Words[0] eq "help"){
	if(scalar(@Words)!=3D1){
	    print("Uso: help");
	}else{
	    print($Help);
	}
    }else{
	# Finalmente, si no es ning=FAn comando conocido, informamos.
	print("Comando no reconocido.\n");
	print("Utilice el comando help para obtener ayuda.\n");
    }
}

Clean();

--=-=-=--
Technical Details
Message-ID: <87n133b3in.fsf@meltdown.ion>
Path: arc1-ca.pugleaf.net!archiver1.google.com!news1.google.com!newsfeed.stanford.edu!newsfeeds.belnet.be!news.belnet.be!newsfeed00.sul.t-online.de!newsfeed01.sul.t-online.de!t-online.de!fu-berlin.de!uni-berlin.de!74-coru-x6.libre.retevision.ES!not-for-mail
References: <9ppc6g$ua$1@localhost.localhost>

Show Full Headers
Complete Article Headers
X-Google-Language: SPANISH,ASCII
X-Google-Thread: f86c8,95686bb050d5fff6
X-Google-Attributes: gidf86c8,public
X-Google-ArrivalTime: 2001-10-07 13:26:59 PST
Path: arc1-ca.pugleaf.net!archiver1.google.com!news1.google.com!newsfeed.stanford.edu!newsfeeds.belnet.be!news.belnet.be!newsfeed00.sul.t-online.de!newsfeed01.sul.t-online.de!t-online.de!fu-berlin.de!uni-berlin.de!74-coru-x6.libre.retevision.ES!not-for-mail
From: kuantiko@escomposlinux.org (Jesús Carrete
  Montaña)
Newsgroups: es.comp.os.linux.programacion
Subject: Re: Perl + database + quitar "par"
Date: 07 Oct 2001 22:26:24 +0200
Lines: 230
Sender: kuantiko@meltdown.ion
Message-ID: <87n133b3in.fsf@meltdown.ion>
References: <9ppc6g$ua$1@localhost.localhost>
NNTP-Posting-Host: 74-coru-x6.libre.retevision.es (62.83.55.74)
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
X-Trace: fu-berlin.de 1002486416 20779464 62.83.55.74 (16 [54696])
X-Orig-Path: relativistic.homeip.net!nobody
User-Agent: Gnus/5.0808 (Gnus v5.8.8) Emacs/20.7