/[suikacvs]/test/suika-accounts/edit.cgi
Suika

Diff of /test/suika-accounts/edit.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by wakaba, Wed Oct 29 14:43:28 2008 UTC revision 1.2 by wakaba, Wed Oct 29 16:27:15 2008 UTC
# Line 29  if (@path == 3 and Line 29  if (@path == 3 and
29      $path[0] eq 'users' and      $path[0] eq 'users' and
30      $path[1] =~ /\A[0-9a-z-]+\z/) {      $path[1] =~ /\A[0-9a-z-]+\z/) {
31    my $user_id = $path[1];    my $user_id = $path[1];
32    check_access_right (allowed_users => {$user_id => 1},    my $ac = check_access_right (allowed_users => {$user_id => 1},
33                        allowed_groups => {'admin-users' => 1});                                 allowed_groups => {'admin-users' => 1});
34    
35    if ($path[2] eq '') {    if ($path[2] eq '') {
36      my $user_prop = get_user_prop ($user_id);      my $user_prop = get_user_prop ($user_id);
# Line 155  if (@path == 3 and Line 155  if (@path == 3 and
155               });               });
156        }        }
157                
158        print q[</section>];        print q[</section><section id=props><h2>Properties</h2>
159    
160    <p><em>Though these properties are only accessible to administrators,
161    you are advised not to expose any confidential data.</em>];
162    
163          print_prop_list ($ac, $user_prop,
164            {
165              name => 'full_name',
166              label => 'Full name',
167              field_type => 'text',
168            },
169            {
170              name => 'mail_addr',
171              label => 'Mail address',
172              field_type => 'email',
173            },
174            {
175              name => 'home_url',
176              label => 'Web site URL',
177              field_type => 'url',
178            },
179          );
180    
181        print qq[<section id=password>        print qq[</section><section id=password>
182  <h2>Password</h2>  <h2>Password</h2>
183    
184  <form action=password method=post accept-charset=utf-8>  <form action=password method=post accept-charset=utf-8>
# Line 209  cannot enable your account by yourself. Line 230  cannot enable your account by yourself.
230          my $action = $cgi->get_parameter ('action');          my $action = $cgi->get_parameter ('action');
231          my $status;          my $status;
232          if ($action eq 'join') {          if ($action eq 'join') {
233            if ($gs->{member}) {            if (scalar $cgi->get_parameter ('agreed')) {
234              $status = q[You are a member];              if ($gs->{member}) {
235              #                $status = q[You are a member];
           } elsif ($gs->{no_approval}) {  
             $status = q[You are waiting for an approval];  
             #  
           } elsif ($gs->{invited}) {  
             $gs->{member} = 1;  
             $status = q[Registered];  
             #  
           } else {  
             if ($group_prop->{join_condition}->{invitation}) {  
               print_error (403, 'You are not invited to this group');  
               exit;  
             } elsif ($group_prop->{join_condition}->{approval}) {  
               $gs->{no_approval} = 1;  
               $status = q[Request submitted];  
236                #                #
237              } else {              } elsif ($gs->{no_approval}) {
238                  $status = q[You are waiting for an approval];
239                  #
240                } elsif ($gs->{invited}) {
241                $gs->{member} = 1;                $gs->{member} = 1;
242                $status = q[Registered];                $status = q[Registered];
243                #                #
244                } else {
245                  if ($group_prop->{join_condition}->{invitation}) {
246                    print_error (403, 'You are not invited to this group');
247                    exit;
248                  } elsif ($group_prop->{join_condition}->{approval}) {
249                    $gs->{no_approval} = 1;
250                    $status = q[Request submitted];
251                    #
252                  } else {
253                    $gs->{member} = 1;
254                    $status = q[Registered];
255                    #
256                  }
257              }              }
258              } else {
259                my $e_group_id = htescape ($group_id);
260                print qq[Content-Type: text/html; charset=utf-8
261    
262    <!DOCTYPE HTML>
263    <html lang=en>
264    <title>Joining the group $e_group_id</title>
265    <link rel=stylesheet href="/www/style/html/xhtml">
266    <h1>Joining the group $e_group_id</h1>
267    
268    <dl>
269    <dt>Description
270    <dd>@{[$group_prop->{desc}]}
271    </dl>
272    
273    <form action="@{[htescape ($cgi->request_uri)]}" accept-charset=utf-8 method=post>
274    <input type=hidden name=action value=join>
275    
276    <p>Do you really want to join this group?
277    <input type=submit name=agreed value=yes>
278    <input type=button value=no onclick="history.back ()">
279    
280    </form>];
281                exit;
282            }            }
283          } elsif ($action eq 'leave') {          } elsif ($action eq 'leave') {
284            if ($gs->{member}) {            if ($gs->{member}) {
# Line 257  cannot enable your account by yourself. Line 304  cannot enable your account by yourself.
304          regenerate_htpasswd_and_htgroup ();          regenerate_htpasswd_and_htgroup ();
305          commit ();          commit ();
306    
307          print qq[Status: 204 $status\n\n];          redirect (303, $status, './');
308          exit;          exit;
309        }        }
310      }      }
# Line 304  cannot enable your account by yourself. Line 351  cannot enable your account by yourself.
351          exit;          exit;
352        }        }
353      }      }
354      } elsif ($path[2] eq 'prop') {
355        if ($cgi->request_method eq 'POST') {
356          lock_start ();
357          my $user_prop = get_user_prop ($user_id);
358          if ($user_prop) {
359            binmode STDOUT, ':encoding(utf-8)';
360    
361            my $prop_name = $cgi->get_parameter ('name');
362            if (defined $prop_name and
363                {
364                  full_name => 1,
365                  mail_addr => 1,
366                  home_url => 1,
367                }->{$prop_name}) {
368              $user_prop->{$prop_name} = $cgi->get_parameter ('value');
369    
370              set_user_prop ($user_id, $user_prop);
371              commit ();
372              
373              print "Status: 204 Property updated\n\n";
374              exit;
375            } else {
376              print_error (400, 'Bad property');
377              exit;
378            }
379          }
380        }
381    }    }
382  } elsif (@path == 3 and  } elsif (@path == 3 and
383           $path[0] eq 'groups' and           $path[0] eq 'groups' and
# Line 325  cannot enable your account by yourself. Line 399  cannot enable your account by yourself.
399  <html lang=en>  <html lang=en>
400  <title>Group $e_group_id</title>  <title>Group $e_group_id</title>
401  <link rel=stylesheet href="/www/style/html/xhtml">  <link rel=stylesheet href="/www/style/html/xhtml">
402  <h1>Group $e_group_id</h1>  <h1>Group $e_group_id</h1>];
403                  
404  <section id=members><h2>Members</h2>];        print q[<section id=props><h2>Properties</h2>];
405    
406          print_prop_list ($ac, $group_prop,
407               {
408                name => 'desc',
409                label => 'Description',
410                field_type => 'textarea',
411                public => 1,
412               },
413               {
414                name => 'admin_group',
415                label => 'Administrative group',
416                field_type => 'text',
417               },
418              );
419    
420          print q[</section><section id=members><h2>Members</h2>];
421    
422        if ($ac->{read_group_member_list}) {        if ($ac->{read_group_member_list}) {
423          my @members;          my @members;
# Line 469  maxlength=20 size=10 required pattern="[ Line 559  maxlength=20 size=10 required pattern="[
559          exit;          exit;
560        }        }
561      }      }
562      } elsif ($path[2] eq 'prop') {
563        forbidden () unless $ac->{write};
564    
565        if ($cgi->request_method eq 'POST') {
566          lock_start ();
567          my $group_prop = get_group_prop ($group_id);
568          if ($group_prop) {
569            binmode STDOUT, ':encoding(utf-8)';
570    
571            my $prop_name = $cgi->get_parameter ('name');
572            if (defined $prop_name and
573                {desc => 1, admin_group => 1}->{$prop_name}) {
574              $group_prop->{$prop_name} = $cgi->get_parameter ('value');
575    
576              set_group_prop ($group_id, $group_prop);
577              commit ();
578              
579              print "Status: 204 Property updated\n\n";
580              exit;
581            } else {
582              print_error (400, 'Bad property');
583              exit;
584            }
585          }
586        }
587    } elsif ($path[2] =~ /\Auser\.([0-9a-z-]+)\z/ or    } elsif ($path[2] =~ /\Auser\.([0-9a-z-]+)\z/ or
588             $path[2] eq 'invite-user') {             $path[2] eq 'invite-user') {
589      my $user_id = $1 // $cgi->get_parameter ('user-id') // '';      my $user_id = $1 // $cgi->get_parameter ('user-id') // '';
# Line 595  title="Use a string of characters 'a'..' Line 710  title="Use a string of characters 'a'..'
710    my $user_id = $cgi->remote_user;    my $user_id = $cgi->remote_user;
711    forbidden () if not defined $user_id or $user_id !~ /\A[0-9a-z-]+\z/;    forbidden () if not defined $user_id or $user_id !~ /\A[0-9a-z-]+\z/;
712    
713    my $user_url = get_absolute_url ('users/' . $user_id . '/');    redirect (303, 'See other', 'users/' . $user_id . '/');
     
   print qq[Status: 303 See Other  
 Location: $user_url  
 Content-Type: text/html; charset=us-ascii  
   
 See <a href="@{[htescape ($user_url)]}">your user page</a>.];  
714    exit;    exit;
715  } elsif (@path == 0) {  } elsif (@path == 0) {
716    my $root_url = get_absolute_url ('edit/');    redirect (301, 'Moved', 'edit/');
   
   print qq[Status: 301 Moved permanently  
 Location: $root_url  
 Content-Type: text/html; charset=us-ascii  
   
 See <a href="@{[htescape ($root_url)]}">other page</a>.];  
717    exit;    exit;
718  }  }
719    
# Line 631  sub print_list_section (%) { Line 734  sub print_list_section (%) {
734    print q[</ul></section>];    print q[</ul></section>];
735  } # print_list_section  } # print_list_section
736    
737    sub print_prop_list ($$@) {
738      my $ac = shift;
739      my $prop_hash = shift;
740    
741      for my $prop (@_) {
742        if ($prop->{public}) {
743          print q[<p><strong>], htescape ($prop->{label}), q[</strong>: ];
744          print $prop_hash->{$prop->{name}};
745        }
746        
747        if ($ac->{write}) {
748          print q[<form action="prop" accept-charset=utf-8 method=post>];
749          print q[<input type=hidden name=name value="], htescape ($prop->{name}), q[">];
750          if ($prop->{field_type} eq 'textarea') {
751            print q[<p><label><strong>], htescape ($prop->{label});
752            print q[</strong>: <br><textarea name="value"];
753            print q[>], htescape ($prop_hash->{$prop->{name}} // '');
754            print q[</textarea></label>];
755            print q[<p><input type=submit value=Save>];
756          } else {
757            print q[<p><label><strong>], htescape ($prop->{label});
758            print q[</strong>: <input type="] . $prop->{field_type};
759            print q[" name="value" ];
760            print q[value="], htescape ($prop_hash->{$prop->{name}} // '');
761            print q["></label> ];
762            print q[<input type=submit value=Save>];
763          }
764          print q[</form>];
765        }
766      }
767    } # print_prop_list
768    
769  sub check_access_right (%) {  sub check_access_right (%) {
770    my %opt = @_;    my %opt = @_;
771        
# Line 640  sub check_access_right (%) { Line 775  sub check_access_right (%) {
775    my $user_prop = get_user_prop ($user_id);    my $user_prop = get_user_prop ($user_id);
776    forbidden () unless $user_prop;    forbidden () unless $user_prop;
777    
778      my $ac = {};
779      my $return_ac;
780    
781    if ($opt{allowed_users}->{$user_id}) {    if ($opt{allowed_users}->{$user_id}) {
782      return {      $ac->{write} = 1;
783              write => 1,      $return_ac = 1;
             #read_group_member_list => 0,  
            };  
784    }    }
785    
   my $ac = {};  
   my $return_ac;  
786    for my $group_id (keys %{$opt{allowed_groups} or {}}) {    for my $group_id (keys %{$opt{allowed_groups} or {}}) {
787      my $group_prop = get_group_prop ($group_id);      my $group_prop = get_group_prop ($group_id);
788      next unless $group_prop;      next unless $group_prop;
# Line 662  sub check_access_right (%) { Line 796  sub check_access_right (%) {
796    if (defined $opt{group_context}) {    if (defined $opt{group_context}) {
797      my $group_prop = get_group_prop ($opt{group_context});      my $group_prop = get_group_prop ($opt{group_context});
798      if ($group_prop) {      if ($group_prop) {
799          if (defined $group_prop->{admin_group}) {
800            my $ag_prop = get_group_prop ($group_prop->{admin_group});
801            if ($ag_prop and
802                $user_prop->{'group.' . $group_prop->{admin_group}}->{member}) {
803              return {write => 1, read_group_member_list => 1};
804            }
805          }
806          
807        my $gs = $user_prop->{'group.' . $opt{group_context}};        my $gs = $user_prop->{'group.' . $opt{group_context}};
808        if ($gs->{member}) {        if ($gs->{member}) {
809          $return_ac = 1;          $return_ac = 1;
# Line 690  sub forbidden () { Line 832  sub forbidden () {
832    exit;    exit;
833  } # forbidden  } # forbidden
834    
835    sub redirect ($$$) {
836      my ($code, $status, $url) = @_;
837      
838      my $abs_url = get_absolute_url ($url);
839    
840      print qq[Status: $code $status
841    Location: $abs_url
842    Content-Type: text/html; charset=us-ascii
843    
844    See <a href="@{[htescape ($abs_url)]}">other page</a>.];
845    } # redirect
846    
847  sub percent_decode ($) {  sub percent_decode ($) {
848    return $dom->create_uri_reference ($_[0])    return $dom->create_uri_reference ($_[0])
849        ->get_iri_reference        ->get_iri_reference
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24