From: Florian Forster Date: Mon, 11 Sep 2006 21:56:14 +0000 (+0200) Subject: licom.cgi: Assume all parameters to be in UTF-8. X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;ds=sidebyside;p=licom.git licom.cgi: Assume all parameters to be in UTF-8. Also ask the browsers specifically to send UTF-8. The following document is an interesting read: --- diff --git a/licom.cgi b/licom.cgi index cd02690..70398b2 100755 --- a/licom.cgi +++ b/licom.cgi @@ -20,6 +20,7 @@ use strict; use warnings; use lib (qw(lib)); +use Encode (qw(encode decode is_utf8)); use CGI (':cgi'); use CGI::Carp (qw(fatalsToBrowser)); use URI::Escape; @@ -48,7 +49,7 @@ our %FieldNames = our $MySelf = $ENV{'SCRIPT_NAME'}; -our $Action = param ('action'); +our $Action = param_utf8 ('action'); $Action ||= 'default'; our %Actions = @@ -72,9 +73,9 @@ read_config (); # make sure AuthLDAPRemoteUserIsDN is enabled. die unless ($ENV{'REMOTE_USER'}); -set_config ('base_dn', $ENV{'REMOTE_USER'}); +#set_config ('base_dn', $ENV{'REMOTE_USER'}); -die unless (defined (get_config ('uri')) +die ("Configuration is incomplete") unless (defined (get_config ('uri')) and defined (get_config ('base_dn')) and defined (get_config ('bind_dn')) and defined (get_config ('password'))); @@ -84,7 +85,7 @@ LiCoM::Connection->connect uri => get_config ('uri'), bind_dn => get_config ('bind_dn'), password => get_config ('password') -) or die; +) or die ("Unable to connect to LDAP directory server " . get_config ('uri')); our ($UserCN, $UserID) = LiCoM::Person->get_user ($ENV{'REMOTE_USER'}); @@ -95,7 +96,7 @@ if (!$UserID and $Action ne 'save') if (!$UserCN) { - die; + die ("No such user in the LDAP directory: " . $ENV{'REMOTE_USER'}); } if (!defined ($Actions{$Action})) @@ -123,7 +124,7 @@ exit (0); sub action_browse { - my $group = param ('group'); + my $group = param_utf8 ('group'); $group = shift if (@_); $group ||= ''; @@ -138,7 +139,7 @@ sub action_browse my @members = $group->get_members (); my $members = scalar (@members); my $group_name = $group->name (); - my $group_uri = uri_escape ($group_name); + my $group_uri = uri_escape_utf8 ($group_name); my $desc = $group->description (); print qq#\t\t\t
  • #, @@ -162,7 +163,7 @@ EOF else { my $group_obj = LiCoM::Group->load ($group); - my $group_uri = uri_escape ($group_obj->name ()); + my $group_uri = uri_escape_utf8 ($group_obj->name ()); my $group_html = encode_entities ($group_obj->name ()); my @member_names = $group_obj->get_members (); my $desc = $group_obj->description (); @@ -174,7 +175,7 @@ EOF for (sort (@member_names)) { my $cn = $_; - my $cn_uri = uri_escape ($cn); + my $cn_uri = uri_escape_utf8 ($cn); my $cn_html = encode_entities ($cn); print qq(\t\t\t
  • $cn_html
    • \n); @@ -193,7 +194,7 @@ EOF sub action_list { - my $group_name = param ('group'); + my $group_name = param_utf8 ('group'); $group_name = shift if (@_); $group_name ||= ''; @@ -255,7 +256,7 @@ EOF my $sn = $person->lastname (); my $gn = $person->firstname (); - my $cn_uri = uri_escape ($cn); + my $cn_uri = uri_escape_utf8 ($cn); my $cn_html = encode_entities ("$sn, $gn"); print "\t\t\t\n", @@ -274,7 +275,7 @@ EOF if ($group_name) { - my $group_esc = uri_escape ($group_name); + my $group_esc = uri_escape_utf8 ($group_name); print qq(\t\t
    [Back]
    \n); } else @@ -285,12 +286,12 @@ EOF sub action_detail { - my $cn = param ('cn'); + my $cn = param_utf8 ('cn'); $cn = shift if (@_); die unless ($cn); my $cn_html = encode_entities ($cn); - my $cn_uri = uri_escape ($cn); + my $cn_uri = uri_escape_utf8 ($cn); my $person = LiCoM::Person->load ($cn); if (!$person) @@ -349,7 +350,7 @@ EOF { my $group = $groups[$i]; my $group_name = $group->name (); - my $group_uri = uri_escape ($group_name); + my $group_uri = uri_escape_utf8 ($group_name); my $group_html = encode_entities ($group_name); print "\t\t\t\n" if ($i != 0); @@ -373,7 +374,7 @@ EOF sub action_search { - my $search = param ('search'); + my $search = param_utf8 ('search'); $search ||= ''; $search =~ s/[^\s\w]//g; @@ -415,7 +416,7 @@ sub action_search { my $person = $_; my $cn = $person->name (); - my $cn_uri = uri_escape ($cn); + my $cn_uri = uri_escape_utf8 ($cn); my $cn_html = encode_entities ($cn); print qq(\t\t
  • $cn_html
    • \n); @@ -427,7 +428,7 @@ sub action_edit { my %opts = @_; - my $cn = param ('cn'); + my $cn = param_utf8 ('cn'); $cn = $opts{'cn'} if (defined ($opts{'cn'})); $cn ||= ''; @@ -444,6 +445,9 @@ sub action_edit my $lastname; my $firstname; + my $lastname_html; + my $firstname_html; + my $contacts = {}; $contacts->{$_} = [] for (@MultiFields); @@ -466,13 +470,16 @@ sub action_edit } } - $lastname = param ('lastname') if (param ('lastname') and $UserID); - $firstname = param ('firstname') if (param ('firstname') and $UserID); + $lastname = param_utf8 ('lastname') if (param_utf8 ('lastname') and $UserID); + $firstname = param_utf8 ('firstname') if (param_utf8 ('firstname') and $UserID); get_contacts ($contacts); $lastname = $opts{'lastname'} if (defined ($opts{'lastname'})); $firstname = $opts{'firstname'} if (defined ($opts{'firstname'})); + $lastname_html = encode_entities ($lastname); + $firstname_html = encode_entities ($firstname); + for (@MultiFields) { my $field = $_; @@ -489,7 +496,7 @@ sub action_edit } print < +
    @@ -498,11 +505,11 @@ sub action_edit EOF if ($UserID) { - print qq(\t\t\t\t\n); + print qq(\t\t\t\t\n); } else { - print qq(\t\t\t\t\n); + print qq(\t\t\t\t\n); } print < @@ -511,11 +518,11 @@ EOF EOF if ($UserID) { - print qq(\t\t\t\t\n); + print qq(\t\t\t\t\n); } else { - print qq(\t\t\t\t\n); + print qq(\t\t\t\t\n); } print "\t\t\t\n"; @@ -601,7 +608,7 @@ EOF sub action_save { - my $cn = $UserID ? param ('cn') : $UserCN; + my $cn = $UserID ? param_utf8 ('cn') : $UserCN; if (verify_fields ()) { @@ -617,7 +624,7 @@ sub action_save die unless ($UserID); - my $button = lc (param ('button')); + my $button = lc (param_utf8 ('button')); $button ||= 'save'; if ($button eq 'cancel') @@ -626,15 +633,15 @@ sub action_save return; } - if (!param ('lastname') or !param ('firstname')) + if (!param_utf8 ('lastname') or !param_utf8 ('firstname')) { print qq(\t
    You have to give both, first and lastname, to identify this record.
    \n); action_edit (cn => ''); return; } - my $lastname = param ('lastname'); - my $firstname = param ('firstname'); + my $lastname = param_utf8 ('lastname'); + my $firstname = param_utf8 ('firstname'); my $contacts = get_contacts (); @@ -648,7 +655,7 @@ sub action_save $cn = $person->name (); - for (param ('group')) + for (param_utf8 ('group')) { my $group_name = $_; my $group = LiCoM::Group->load ($group_name); @@ -664,10 +671,10 @@ sub action_save } } - if (param ('newgroup')) + if (param_utf8 ('newgroup')) { # FIXME add error handling - my $group_name = param ('newgroup'); + my $group_name = param_utf8 ('newgroup'); LiCoM::Group->create ($group_name, '', $cn); } @@ -683,12 +690,12 @@ sub action_save sub action_update { - my $cn = $UserID ? param ('cn') : $UserCN; - my $person = LiCoM::Person->load ($cn); + my $cn = $UserID ? param_utf8 ('cn') : $UserCN; - die unless ($person); + my $person = LiCoM::Person->load ($cn); + die ("Unable to load CN `$cn'") unless ($person); - my $button = lc (param ('button')); + my $button = lc (param_utf8 ('button')); $button ||= 'save'; if ($UserID and $button eq 'cancel') @@ -699,17 +706,39 @@ sub action_update if ($UserID) { - my $lastname = param ('lastname'); - my $firstname = param ('firstname'); + my $lastname = param_utf8 ('lastname'); + my $firstname = param_utf8 ('firstname'); + + my $old_cn = $person->name (); + + print < + \$lastname = $lastname
    + \$firstname = $firstname
    + \$old_cn = $old_cn +     +HTML $person->lastname ($lastname) if ($lastname and $lastname ne $person->lastname ()); $person->firstname ($firstname) if ($firstname and $firstname ne $person->firstname ()); $cn = $person->name (); - # FIXME Fix groups: - # Each group is one entry of type (objectClass=groupOfNames) - # with one or more `member' attributes. These attributes are - # the `dn' (distinguished name) of the member entries. + + # Change the cn's saved in the groups + if ($old_cn ne $cn) + { + my @groups = LiCoM::Group->load_by_member ($old_cn); + for (@groups) + { + # ->del_members automatically deleted the + # group, if no more members exist. So this + # order is important. + print "
    \$cn = " . encode_entities ($cn) . "; " + . "\$old_cn = " . encode_entities ($old_cn) . ";
    \n"; + $_->add_members ($cn); + $_->del_members ($old_cn); + } + } # if ($old_cn ne $cn) } my $contacts = get_contacts (); @@ -734,7 +763,7 @@ sub action_update # only `authorized' users may see and change groups if ($UserID) { - my %changed_groups = map { $_ => 1 } (param ('group')); + my %changed_groups = map { $_ => 1 } (param_utf8 ('group')); my @current_groups = LiCoM::Group->load_by_member ($cn); for (@current_groups) @@ -759,10 +788,10 @@ sub action_update $group_obj->add_members ($cn); } - if (param ('newgroup')) + if (param_utf8 ('newgroup')) { # FIXME add error handling - my $group_name = param ('newgroup'); + my $group_name = param_utf8 ('newgroup'); LiCoM::Group->create ($group_name, '', $cn); } } @@ -788,7 +817,7 @@ HTML sub action_vcard { - my $cn = param ('cn'); + my $cn = param_utf8 ('cn'); $cn = shift if (@_); die unless ($cn); @@ -808,7 +837,7 @@ sub action_vcard my $sn = $person->lastname (); my $gn = $person->firstname (); - my $cn_esc = uri_escape ($cn); + my $cn_esc = uri_escape_utf8 ($cn); print <get ('mail'); if (!$owner_mail) { - my $cn_uri = uri_escape ($UserCN); + my $cn_uri = uri_escape_utf8 ($UserCN); print qq(\t\t
    You have no email set in your own profile. Edit it now!
    \n); return (0); } @@ -954,13 +983,13 @@ EOM sub action_ask_del { - my $cn = param ('cn'); + my $cn = param_utf8 ('cn'); $cn or die; my $person = LiCoM::Person->load ($cn); $person or die; - my $cn_uri = uri_escape ($cn); + my $cn_uri = uri_escape_utf8 ($cn); my $cn_html = encode_entities ($cn); print <Edit contact group "$group_name_html" - +
    $lastname$lastname_html$firstname$firstname_html
    @@ -1040,7 +1069,7 @@ HTML sub action_save_group { - my $group_name = param ('group') or die; + my $group_name = param_utf8 ('group') or die; my $group_name_html = encode_entities ($group_name); @@ -1052,7 +1081,7 @@ sub action_save_group return; } - my $desc = param ('description'); + my $desc = param_utf8 ('description'); $group_obj->description ($desc); action_browse (); @@ -1286,20 +1315,20 @@ EOF if ($UserID) { - my $search = param ('search') || ''; + my $search = param_utf8 ('search') || ''; $search = encode_entities ($search); print < - + -
    + -
    + @@ -1366,7 +1395,7 @@ sub pwgen sub verify_fields { my @errors = (); - for (param ('uri')) + for (param_utf8 ('uri')) { my $val = $_; next unless ($val); @@ -1378,7 +1407,7 @@ sub verify_fields } } - for (param ('homephone'), param ('cellphone'), param ('officephone'), param ('fax')) + for (param_utf8 ('homephone'), param_utf8 ('cellphone'), param_utf8 ('officephone'), param_utf8 ('fax')) { my $number = $_; next unless ($number); @@ -1408,7 +1437,7 @@ sub markup_field my $field = shift; my $value = shift; - my $value_uri = uri_escape ($value); + my $value_uri = uri_escape_utf8 ($value); my $value_html = encode_entities ($value); if ($field eq 'group') @@ -1419,11 +1448,11 @@ sub markup_field { if ($value =~ m#^([a-z]+)://(.+)$#) { - $value_uri = $1 . '://' . uri_escape ($2); + $value_uri = $1 . '://' . uri_escape_utf8 ($2); } else { - $value_uri = 'http://' . uri_escape ($value); + $value_uri = 'http://' . uri_escape_utf8 ($value); } return (qq($value_html)); } @@ -1441,7 +1470,7 @@ sub get_contacts for (@MultiFields) { my $field = $_; - my @values = grep { $_ } (param ($field)); + my @values = grep { $_ } (param_utf8 ($field)); next unless (@values); @@ -1459,3 +1488,35 @@ sub get_contacts return ($contacts); } + +sub is_valid_utf8 +{ + my $str = join ('', @_); + + # Taken from here: + return ($str =~ m/^( + [\x09\x0A\x0D\x20-\x7E] # ASCII + | [\xC2-\xDF][\x80-\xBF] # non-overlong 2-byte + | \xE0[\xA0-\xBF][\x80-\xBF] # excluding overlongs + | [\xE1-\xEC\xEE\xEF][\x80-\xBF]{2} # straight 3-byte + | \xED[\x80-\x9F][\x80-\xBF] # excluding surrogates + | \xF0[\x90-\xBF][\x80-\xBF]{2} # planes 1-3 + | [\xF1-\xF3][\x80-\xBF]{3} # planes 4-15 + | \xF4[\x80-\x8F][\x80-\xBF]{2} # plane 16 + )*$/x); +} + +sub param_utf8 +{ + my @args = @_; + my @ret = (); + + @ret = grep { is_valid_utf8 ($_) } (param (@args)); + $_ = decode ('UTF-8', $_) for (@ret); + return (wantarray () ? @ret : $ret[0]); +} + +sub uri_escape_utf8 +{ + return (uri_escape (encode ('UTF-8', shift))); +}