Thread Problem mit CGI::Session (14 answers)
Opened by Yagyu at 2010-12-18 11:40

topeg
 2010-12-18 18:32
#143693 #143693
User since
2006-07-10
2611 Artikel
BenutzerIn

user image
Also hier mal etwas das funktioniert:

mydb.pm:
more (33.5kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144

package mydb;
use strict;
use warnings;
use Digest::MD5 qw(md5_hex);
use utf8;

sub new
{
  my $class=shift;
  my $file=shift;
  return undef unless($file);
  my $self={};
  $self->{file}  =$file;
  $self->{table} ={};
  $self->{update}=0;
  $self->{last}  =0;
  bless($self,ref($class)||$class);
  $self->load;
  return $self;
}

sub DESTROY{ shift->save(); }

sub load
{
  my $self=shift;
  $self->{update}=1;
  return 0 unless(-f $self->{file});
  if(open(my $fh, '<', $self->{file}))
  {
    while(<$fh>)
    {
      chomp;
      my ($name,$pass)=map{__unquote($_)}split(/#/,$_,2);
      next unless($name && $pass);
      $self->{table}->{$name}=$pass;
    }
    close($fh);
    $self->{update}=0;
    $self->{last}=-M $self->{file};
  }
}

sub save
{
  my $self=shift;
  if($self->{update} && %{$self->{table}})
  {
    my $str=join("\n",map{__quote($_).'#'.__quote($self->{table}->{$_})}keys(%{$self->{table}}));
    $self->_update();
    if(open(my $fh, '>', $self->{file}))
    {
      print $fh $str;
      close($fh);
      $self->{update}=0;
      return 1;
    }
    return 0
  }
  return 1;
}

sub add
{
  my $self=shift;
  my $name=shift;
  my $pass=shift;
  $self->_update();
  return 0 unless($name && $pass);
  return 0 if(exists($self->{table}->{$name}));
  $self->{table}->{$name}=md5_hex($pass);
  $self->{update}=1;
  return 1;
}

sub del
{
  my $self=shift;
  my $name=shift;
  $self->_update();
  return 0 unless($name && exists($self->{table}->{$name}));
  delete($self->{table}->{$name});
  $self->{update}=1;
  return 1;
}

sub has{ return exists($_[0]->{table}->{$_[1]}); }

sub set
{
  my $self=shift;
  my $name=shift;
  my $pass=shift;
  $self->_update();
  return 0 unless($name && $pass);
  return 0 unless(exists($self->{table}->{$name}));
  $self->{table}->{$name}=md5_hex($pass);
  $self->{update}=1;
  return 1;
}

sub chk
{
  my $self=shift;
  my $name=shift;
  my $pass=shift;
  $self->_update();
  return 0 unless($name && $pass && exists($self->{table}->{$name}) && $self->{table}->{$name} eq md5_hex($pass));
  return 1;
}

sub get
{
  my $self=shift;
  my $name=shift;
  $self->_update();
  return $self->{table}->{name} if($name && exists($self->{table}->{name}));
  return '';
}

########################################################################
sub _update
{
  my $self=shift;
  return $self->load() if(-f $self->{file} && (!$self->{last} || -M $self->{file} != $self->{last}));
  return 1;
}

########################################################################
sub __quote
{
  my $str=shift;
  $str=~s/#/&raute;/g;
  return $str;
}

sub __unquote
{
  my $str=shift;
  $str=~s/\Q&raute;/#/g;
  return $str;
}

1;


registration.pl:
more (31.5kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119

#!/usr/bin/perl
use strict;
use warnings;
use mydb;
use CGI;
use CGI::Session;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use utf8;

my $db=mydb->new('test.db');
my $form = CGI->new();
my $session = CGI::Session->new("driver:File", $form, { Directory=>"/tmp" }) or die CGI::Session->errstr;

my $sname=$ENV{SCRIPT_NAME}||'registration.pl';

print $session->header();
warningsToBrowser(1);

my $aktion=$form->param('aktion') || 'init';
$form->delete('aktion');

if($aktion eq 'add')
{
  my $name=$session->param('name');
  my $pass=$session->param('pass');
  if($name && $pass && $db->add($name,$pass))
  {
    $db->save();
    print_add($sname,$form);
  }
  else
  { print_input($sname,$form,"Name / Passort sind nicht gesetzt!") }
}
elsif($aktion eq 'check')
{
  my $name=$form->param('name');
  my $pass=$form->param('pass1');
  if($pass ne $form->param('pass2'))
  { print_input($sname,$form,'Die Passwörter stimmen nicht überein!'); }
  elsif($db->has($name))
  { print_input($sname,$form,'Der Name ist schon registrieret!'); }
  else
  {
    $session->param('name',$name);
    $session->param('pass',$pass);
    print_check($sname,$form,$name);
  }
}
elsif($aktion eq 'init')
{ print_input($sname,$form); }
else
{ print_input($sname,$form,'unerlaubte Aktion!'); }

########################################################################
sub print_add
{
  my $sname=shift;
  my $form=shift;
  my $name=shift;
  print
    $form->start_html("Registrierung abgeschlossen!"),
    $form->h1("Registrierung abgeschlossen!"),
    $form->p("Ihre Eingaben wurden akzeptiert. Sie können sich unter dem namen $name anmelden."),
    $form->end_html();
}

sub print_check
{
  my $sname=shift;
  my $form=shift;
  print
    $form->start_html("Ihre Eingaben"),
      $form->startform(-action => $sname, -method => 'POST' ),
        $form->hidden('aktion','add'),
        $form->h1("Ihre Eingaben"),
        $form->table({-border=>1},
          $form->Tr({-align=>'CENTER' ,-valign=>'TOP'}, [
            $form->td(["NAME:",     $form->param('name')]),
            $form->td(["PASSWORT:", $form->param('pass1')]),
          ]),
        ),
        $form->br(),
        $form->submit("Registrierung abschließen"),
      $form->endform(),
      $form->startform(-action => $sname, -method => 'POST'),
        $form->hidden('aktion','init'),
        $form->submit("Ändern"),
      $form->endform(),
    $form->end_html();
}

sub print_input
{
  my $sname=shift;
  my $form=shift;
  my $message=shift;
  print
    $form->start_html("Registration"),
      $form->h1("Registration | Ausleihe MMSZ.org"),
      $form->h4("Bitte geben Sie Ihre Daten ein"),
      $form->startform(-action => $sname, -method => 'POST' ),
        $form->hidden('aktion','check'),
        $form->table({-border=>0},
          $form->Tr({-align=>"LEFT", -valign=>"TOP"},[
            $form->td(['Name'                 , $form->textfield(     -name=>'name',  -size=>30, -maxlength=>30, -value=>$form->param('name')), "", ""]),
            $form->td(['Passwort'             , $form->password_field(-name=>'pass1', -size=>30, -maxlength=>30                              ), "", ""]),
            $form->td(['Passwort wiederholen' , $form->password_field(-name=>'pass2', -size=>30, -maxlength=>30                              ), "", ""]),
          ]),
        ),
        $form->br(),
        $form->submit("Registrieren"),
        " ",
        $form->reset("Löschen");

print   $form->br(),$form->p("NACHRICHT:$message") if($message);

print $form->endform(),
    $form->end_html();
}


login.pl:
more (19.0kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81

#!/usr/bin/perl
use strict;
use warnings;
use mydb;
use CGI;
use CGI::Session;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use utf8;

my $db=mydb->new('test.db');
my $form = CGI->new();
my $session = CGI::Session->new("driver:File", $form, { Directory=>"/tmp" }) or die CGI::Session->errstr;

my $sname=$ENV{SCRIPT_NAME}||'login.pl';

print $session->header();
warningsToBrowser(1);

my $login=$session->param("loggedin");

my $name=$form->param('name');
my $pass=$form->param('pass');

if($form->param('logout'))
{
  $session->delete('loggedin','name','pass');
  print_login($sname,$form); # <== print_ vergessen...
}
elsif($login)
{
  my $name=$session->param('name');
  login_ok($sname,$form,$name);
}
elsif($db->chk($name, $pass))
{
  $session->param("loggedin",1);
  $session->param('name',$name);
  print_ok($sname,$form,$name);
}
else
{ print_login($sname,$form); }

########################################################################

sub print_login
{
  my $sname=shift;
  my $form=shift;
  print
    $form->start_html("LOGIN"),
      $form->h1("Login | Ausleihe MMSZ.org"),
      $form->h4("LOGIN"),
      $form->startform(-action => $sname, -method => 'POST' ),
        $form->table({-border=>0},
          $form->Tr({-align=>"LEFT", -valign=>"TOP"},[
            $form->td(['Name'                 , $form->textfield(     -name=>'name',  -size=>30, -maxlength=>30, -value=>$form->param('name'))]),
            $form->td(['Passwort'             , $form->password_field(-name=>'pass', -size=>30, -maxlength=>30                               )]),
          ]),
        ),
        $form->br(),
        $form->submit("Login"),
        " ",
        $form->reset("Löschen"),
      $form->endform(),
    $form->end_html();
}

sub print_ok
{
  my $sname=shift;
  my $form=shift;
  my $name=shift;
  print
    $form->start_html("LOGIN OK!"),
    $form->h1("Login erfolgreich!"),
    $form->p("Willkommen $name"),
    $form->h4(
      $form->a({href=>"$sname?logout=1"},"LOGOUT"),
    ),
    $form->end_html();
}


test.pl:
more (12.3kb):
Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

#!/usr/bin/perl
use strict;
use warnings;
use mydb;
use CGI;
use CGI::Session;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use utf8;

my $db=mydb->new('test.db');
my $form = CGI->new();
my $session = CGI::Session->new("driver:File", $form, { Directory=>"/tmp" }) or die CGI::Session->errstr;

my $sname=$ENV{SCRIPT_NAME}||'test.pl';

print $session->header();
warningsToBrowser(1);

my $user=$session->param('name');
my $login=$session->param("loggedin");

if($login)
{
  print_ok($sname,$form,$user);
}
else
{
  print_login($sname,$form);
}

########################################################################

sub print_ok
{
  my $sname=shift;
  my $form=shift;
  my $suser=shift;
  print
    $form->start_html("Viele tolle sachen!"),
    $form->h1("Hallo $user!"),
    $form->p("Es ist schön sie zu sehen!"),
    $form->h4(
      $form->a({href=>"login.pl?logout=1"},"LOGOUT"),
    ),
    $form->end_html();
}

sub print_login
{
  my $sname=shift;
  my $form=shift;
  print
    $form->start_html("Bitte Einloggen!"),
    $form->h1("Diese seite ist Passortgeschützt!!"),
    $form->p("Bitte Loggen sie sich ein!"),
    $form->h4(
      $form->a({href=>"login.pl"},"LOGIN"),
    ),
    $form->br(),
    $form->h4(
      $form->a({href=>"registration.pl"},"Registrieren"),
    ),
    $form->end_html();
}


EDIT: Fehler im Code gefunden.
EDIT: Fehler im Code (mydb.pm) bei "load" das chomp vergessen.
EDIT: Fehler im Code (mydb.pm) bei "check" der Vergleich des Passwortes muss "eq" sein nicht "ne" durch das fehlende "chomp" ist es nicht aufgefallen. :-/

modedit Editiert von pq: more-tags aufgrund der menge hinzugefügt
Last edited: 2011-02-01 20:00:05 +0100 (CET)

View full thread Problem mit CGI::Session