qf.cgi
changeset 2 93f3693c31a0
parent 1 5cee74cc1991
child 3 f501f512f8d3
equal deleted inserted replaced
1:5cee74cc1991 2:93f3693c31a0
    22 
    22 
    23 use strict;
    23 use strict;
    24 use warnings;
    24 use warnings;
    25 
    25 
    26 use CGI;
    26 use CGI;
       
    27 
    27 #use Net::Sieve;
    28 #use Net::Sieve;
    28 use Net::ManageSieve;
    29 use Net::ManageSieve;
    29 
    30 
    30 my $host = 'localhost';
    31 my $host        = 'localhost';
    31 my $verify_crt = 0;
    32 my $verify_crt  = 0;
    32 my $requiretls = 'require';
    33 my $requiretls  = 'require';
    33 my $script_name = 'ius';
    34 my $script_name = 'ius';
    34 
    35 
    35 my $status = 'OK';
    36 my $status = 'OK';
    36 
    37 
    37 # error( [ { status => 'user visible message' } ] [,] [ @messages ] );
    38 # error( [ { status => 'user visible message' } ] [,] [ @messages ] );
    38 sub error {
    39 sub error {
    39 
    40 
    40     my $h;
    41     my $h;
    41     $status = ( ref $_[0] eq 'HASH' and $h = shift and defined $h->{status} ) ? delete $h->{status} : 'Interner Fehler';
    42     $status =
       
    43       (ref $_[0] eq 'HASH' and $h = shift and defined $h->{status})
       
    44       ? delete $h->{status}
       
    45       : 'Interner Fehler';
    42     warn @_ if defined @_ and @_;
    46     warn @_ if defined @_ and @_;
    43     exit -1;
    47     exit -1;
    44 
    48 
    45 }
    49 }
    46 
    50 
    55 
    59 
    56 sub script_exists {
    60 sub script_exists {
    57 
    61 
    58     my ($sieve, $script) = @_;
    62     my ($sieve, $script) = @_;
    59     my $scripts = $sieve->listscripts
    63     my $scripts = $sieve->listscripts
    60         or error "Can't list scripts: $@";
    64       or error "Can't list scripts: $@";
    61     return $script ~~ @{$scripts};
    65     return $script ~~ @{$scripts};
    62 
    66 
    63 }
    67 }
    64 
    68 
    65 sub script_isactive {
    69 sub script_isactive {
    66 
    70 
    67     my ($sieve, $script) = @_;
    71     my ($sieve, $script) = @_;
    68     my $scripts = $sieve->listscripts
    72     my $scripts = $sieve->listscripts
    69         or error "Can't list scripts: $@";
    73       or error "Can't list scripts: $@";
    70     return $script eq $scripts->[-1];
    74     return $script eq $scripts->[-1];
    71 
    75 
    72 }
    76 }
    73 
    77 
    74 my $css = <<EOC;
    78 my $css = <<EOC;
    83 input[type=text], input[type=password] {
    87 input[type=text], input[type=password] {
    84     text-align: right;
    88     text-align: right;
    85 }
    89 }
    86 EOC
    90 EOC
    87 
    91 
    88 my $q = new CGI;
    92 my $q     = new CGI;
    89 my $title = 'Mailumleitung einrichten';
    93 my $title = 'Mailumleitung einrichten';
    90 
    94 
    91 
    95 print $q->header(-charset => 'UTF-8');
    92 print $q->header( -charset => 'UTF-8' );
       
    93 print $q->start_html(
    96 print $q->start_html(
    94     -title  => $title,
    97     -title  => $title,
    95     -style  => { -code => $css },
    98     -style  => { -code => $css },
    96     -onload => q{document.forms['theform'].elements['user'].focus();}
    99     -onload => q{document.forms['theform'].elements['user'].focus();}
    97   ),
   100   ),
    98   $q->h3( { -id => 'header' }, $title ),
   101   $q->h3({ -id => 'header' }, $title),
    99   $q->hr;
   102   $q->hr;
   100 
   103 
   101 my $p;
   104 my $p;
   102 $p->{$_} = $q->param($_) for qw(user pass address keep add del);
   105 $p->{$_} = $q->param($_) for qw(user pass address keep add del);
   103 
   106 
   104 print $q->start_form( -id => 'theform' ),
   107 print $q->start_form(-id => 'theform'),
   105   $q->table(
   108   $q->table(
   106     $q->Tr( $q->td('Ihr Nutzername'), $q->td( $q->textfield('user') ) ),
   109     $q->Tr($q->td('Ihr Nutzername'), $q->td($q->textfield('user'))),
   107     $q->Tr( $q->td('Ihr Passwort'), $q->td( $q->password_field('pass') ) ),
   110     $q->Tr($q->td('Ihr Passwort'),   $q->td($q->password_field('pass'))),
   108     $q->Tr( $q->td('Umleitung zu'), $q->td( $q->textfield('address') ) ),
   111     $q->Tr($q->td('Umleitung zu'),   $q->td($q->textfield('address'))),
   109     $q->Tr( $q->td( $q->checkbox(
   112     $q->Tr(
   110             -name => 'keep',
   113         $q->td(
   111             -label => 'Kopie behalten?',
   114             $q->checkbox(
   112             -checked => 1) ) ),
   115                 -name    => 'keep',
   113     $q->Tr( $q->td( $q->submit( { -name => 'add', -value => 'einrichten' } ) ),
   116                 -label   => 'Kopie behalten?',
   114         $q->td( $q->submit( { -name => 'del', -value => 'entfernen' } ) )
   117                 -checked => 1
       
   118             )
       
   119         )
       
   120     ),
       
   121     $q->Tr(
       
   122         $q->td($q->submit({ -name => 'add', -value => 'einrichten' })),
       
   123         $q->td($q->submit({ -name => 'del', -value => 'entfernen' }))
   115     ),
   124     ),
   116   ),
   125   ),
   117   $q->end_form;
   126   $q->end_form;
   118 
   127 
   119 error( { status => 'Bitte geben Sie Ihren Nutzernamen an.' } )  unless defined $p->{user} and $p->{user} ne '';
   128 error({ status => 'Bitte geben Sie Ihren Nutzernamen an.' })
   120 error( { status => 'Bitte geben Sie Ihr Passwort an.' } )  unless defined $p->{pass} and $p->{pass} ne '';
   129   unless defined $p->{user} and $p->{user} ne '';
       
   130 error({ status => 'Bitte geben Sie Ihr Passwort an.' })
       
   131   unless defined $p->{pass} and $p->{pass} ne '';
   121 
   132 
   122 my $s = Net::ManageSieve->new(host => $host, tls => $requiretls ) or error "Can't connect sieve service";
   133 my $s = Net::ManageSieve->new(host => $host, tls => $requiretls)
   123 error( { status => 'Anmeldung fehlgeschlagen.' }, "auth failed: $@" ) unless ($s->login($p->{user}, $p->{pass}));
   134   or error "Can't connect sieve service";
       
   135 error({ status => 'Anmeldung fehlgeschlagen.' }, "auth failed: $@")
       
   136   unless ($s->login($p->{user}, $p->{pass}));
   124 
   137 
   125 if ( defined $p->{add} and $p->{add} ne '' ) {
   138 if (defined $p->{add} and $p->{add} ne '') {
   126 
   139 
   127     error( { status => 'Bitte geben Sie eine Umleitungsaddresse an.' } ) unless defined $p->{address} and $p->{address} ne '';
   140     error({ status => 'Bitte geben Sie eine Umleitungsaddresse an.' })
   128     error "Can't putscript: $@" unless $s->putscript($script_name, redirect($p->{address}, $p->{keep}));
   141       unless defined $p->{address} and $p->{address} ne '';
       
   142     error "Can't putscript: $@"
       
   143       unless $s->putscript($script_name, redirect($p->{address}, $p->{keep}));
   129     error "Can't setactive: $@" unless $s->setactive($script_name);
   144     error "Can't setactive: $@" unless $s->setactive($script_name);
   130     $status = 'Umleitung eingerichtet.';
   145     $status = 'Umleitung eingerichtet.';
   131 
   146 
   132 } elsif ( defined $p->{del} and $p->{del} ne '' ) {
   147 } elsif (defined $p->{del} and $p->{del} ne '') {
   133 
   148 
   134     error "Can't setactive: $@" if script_isactive($s, $script_name) and not $s->setactive();
   149     error "Can't setactive: $@"
   135     error "Can't deletescript: $@" if script_exists($s, $script_name) and not $s->deletescript($script_name);
   150       if script_isactive($s, $script_name)
       
   151           and not $s->setactive();
       
   152     error "Can't deletescript: $@"
       
   153       if script_exists($s, $script_name)
       
   154           and not $s->deletescript($script_name);
   136     $status = 'Umleitung entfernt.';
   155     $status = 'Umleitung entfernt.';
   137 
   156 
   138 } else { error "Nothing to do!"; }
   157 } else {
       
   158     error "Nothing to do!";
       
   159 }
   139 
   160 
   140 exit 0;
   161 exit 0;
   141 
   162 
   142 END {
   163 END {
   143     defined $s and $s->logout;
   164     defined $s and $s->logout;
   144     print $q->hr, $q->p( $status ), $q->end_html;
   165     print $q->hr, $q->p($status), $q->end_html;
   145 }
   166 }
   146 
   167 
   147 __END__
   168 __END__
   148 
   169 
   149 =pod
   170 =pod