Article View: es.comp.os.linux.programacion
Article #11805Re: Perl + database + quitar "par"
From: Jesús Carrete Montaña
Date: Sun, 07 Oct 2001 20:26
Date: Sun, 07 Oct 2001 20:26
230 lines
7902 bytes
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-mailReferences:
<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