Thomas Hooge
8 years ago
commit
e136e7cbbf
@ -0,0 +1,212 @@ |
||||
$Id: CHANGES,v 1.23 2006/07/25 20:10:54 sm Exp $ |
||||
|
||||
version 0.7.5 - Tue July 25 2006 |
||||
* added swedish translation |
||||
many thanks to Daniel Nylander |
||||
|
||||
version 0.7.4 - Thu June 29 2006 |
||||
* fixed invalid filename encoding with german umlauts in base64 |
||||
thanks to Bruno Blumenthal |
||||
* Fixed display of UTF8 characters in the GUI |
||||
Debian #367829 |
||||
|
||||
version 0.7.3 - Tue May 23 2006 |
||||
* Add environment variable |
||||
Gentoo #78576 |
||||
thanks to dragonheart at gentoo dot org |
||||
* Fixed crash when CA is created with nsCertType |
||||
Debian #354386 |
||||
|
||||
version 0.7.3 - Tue May 23 2006 |
||||
* Enhanced version detection |
||||
thanks to Peter Marschall |
||||
Debian #360766 #360555 |
||||
* Changed command for openssl due to changed openssl behavior |
||||
regarding fingerprints |
||||
thanks to Peter Marschall |
||||
Debian #360768 |
||||
* Added "friendly name" to PKCS#12 export |
||||
Debian #364617 |
||||
* Corrected exit call |
||||
thanks to Peter Marschall |
||||
Debian #360767 |
||||
|
||||
|
||||
version 0.7.2 - Sat Feb 18 2006 |
||||
* Fixed bug, which made keysize always 4096 |
||||
* Implemented correct usage of openssl crl depending on openssl version |
||||
* Added tar file support for export |
||||
|
||||
version 0.7.1 - Sat Oct 22 2005 |
||||
* Fixed possible crashbug, thanks to |
||||
* Choose CA validity as maximal certificate lifetime |
||||
* correctly include/don't include keys in exported certificate files |
||||
thanks to "thus0 at free dot fr" |
||||
* added ripemd160 support, thanks to Wim Lewis |
||||
* added possibility to create pkcs#12 without password |
||||
* fixed broken OU in SubCA, thanks to Charles Lepple |
||||
* fixed bug which made saving options with comboboxes impossible |
||||
thanks to "thus0 at free dot fr" |
||||
* fixed bug inseting the right serial number during import |
||||
thanks to Daniel Kahn Gillmor |
||||
|
||||
version 0.7.0 - Sun Apr 10 2005 |
||||
* migrated to perl-Gtk2 |
||||
* added advanced export options (Debian #293931) |
||||
* added CA history |
||||
* fixed some minor bugs |
||||
|
||||
version 0.6.8 (beta) - Sun Feb 20 2004 |
||||
* added detection for openssl 0.9.8 |
||||
* removed crlDistributionPoint for Root-CA |
||||
* added patch for multiple OUs |
||||
Thanks to Uwe Arndt <arndt@uni-koblenz.de> |
||||
* added patch for multiple subjectAltName extensions (Debian #271183) |
||||
Thanks to Peter Marschall <peter@adpm.de> |
||||
|
||||
version 0.6.7 (beta) - Mon Dec 5 2004 |
||||
* added import functionality |
||||
|
||||
version 0.6.6 (beta) - Fri Aug 13 2004 |
||||
* added czech translation |
||||
Thanks to Robert Wolf <gentoo@slave.umbr.cas.cz> |
||||
|
||||
version 0.6.5 (beta) - Thu Aug 05 2004 |
||||
* added spanish translation |
||||
Thanks to Ramon Pons Vivanco <rpons@rinu.org> |
||||
* force (re)parsing a newly created request |
||||
* force delete of internal structures, when deleting a CA |
||||
|
||||
version 0.6.4 (beta) - Thu Jul 15 2004 |
||||
* fixed bug, showing wrong options for renewal of certificates |
||||
* fixed bug creating requests via rightclick directly after creating a new CA |
||||
(thanks to wbx@openbsd.de) |
||||
* fixed bug which added ugly empty box to cert/req page |
||||
* fixed bug with wrong openssl.conf during startup (server-cert with |
||||
ca-extensions) |
||||
(thanks to bernhard.dawuidow@tronicplanet.de) |
||||
* fixed ca-config dialog during creation of root-ca (drop-downs) |
||||
(thanks to X_KurJ@viessmann.com) |
||||
* revocation reason can be given with openssl 0.9.7 |
||||
* changed default exportdir to users home |
||||
* remeber exportdir from last export |
||||
* added possibility to set the extension extendedKeyUsage |
||||
* added possibility to leave email out of the subject dn (0.9.7) |
||||
|
||||
version 0.6.3 (beta) - Wed Jun 16 2004 |
||||
* fixed bug which made it impossible to create new requests |
||||
|
||||
version 0.6.2 (beta) - Sun Jun 13 2004 |
||||
* added new look for some functions |
||||
* key, request and certificate can be generated in one step |
||||
* code cleanup |
||||
|
||||
version 0.6.1 (beta) - Sat May 22 2004 |
||||
* fixed bug, which made it impossible to create a new Root-CA |
||||
Thanks to Olaf Gellert <og@pre-secure.de> |
||||
|
||||
version 0.6.0 (beta) - Tue May 11 2004 |
||||
* some minor usability improvements |
||||
* added possibility to create SubCAs now |
||||
* added possibility also to use DSA keys |
||||
* added possibility to select the digest during key creation |
||||
* added possibility to export the complete CA-chain of a SubCA |
||||
Thanks a lot to Olaf Gellert <og@pre-secure.de> for ideas and patches. |
||||
|
||||
version 0.5.4 (beta) - Fri Oct 3 2003 |
||||
* added a lot of configuration options |
||||
* correctly import/show details of requests without extensions |
||||
(thanks to James.Leavitt@anywaregroup.com) |
||||
|
||||
version 0.5.3 (beta) - Mon Sep 29 2003 |
||||
* fixed wrong label while creating new CA |
||||
* fixed bug, saving configuration is possible again |
||||
|
||||
version 0.5.2 (beta) - Mon Sep 1 2003 |
||||
* added renewal of certificates |
||||
|
||||
version 0.5.1 (beta) - Tue Aug 26 2003 |
||||
* code cleanup |
||||
* fixed some minor bugs and typos |
||||
* corrected some window sizes and tables |
||||
* added accelerators to the menu |
||||
|
||||
version 0.5.0 (beta) - Sat Aug 16 2003 |
||||
* GUI rewriten with perl-Gtk/Gnome |
||||
|
||||
version 0.4.9 (beta) - Sat Jul 5 2003 |
||||
* added german translation |
||||
|
||||
version 0.4.8 (beta) - Tue Jul 1 2003 |
||||
* convert index.txt if openssl changed from 0.9.6x to 0.9.7x |
||||
|
||||
version 0.4.7 (beta) - Fri Jun 27 2003 |
||||
* added export into zip-file |
||||
thanks to ludwig.nussel@suse.de |
||||
|
||||
version 0.4.6 (beta) - Mon Jun 23 2003 |
||||
* some tiny usability improvements |
||||
thanks to ludwig.nussel@suse.de again |
||||
|
||||
version 0.4.5 (beta) - Thu Jun 19 2003 |
||||
* some usability improvements |
||||
thanks to ludwig.nussel@suse.de |
||||
* some more configuration options |
||||
|
||||
version 0.4.4 (beta) - Fri Oct 4 2002 |
||||
* Fixed bug exporting keys in PEM format |
||||
* Fixed possible empty lines in cert/key/reqlist |
||||
thanks to waldemar.mertke@gmx.de |
||||
|
||||
version 0.4.3 (beta) - Fri Sep 27 2002 |
||||
* Fixed some minor bugs and typos (e.g. concerning openssl 0.9.7) |
||||
thanks to iebgener@yahoo.com and waldemar.mertke@gmx.de |
||||
|
||||
version 0.4.2 (beta) - Sat Aug 24 2002 |
||||
* fixed revocation when serial is > 15 |
||||
thanks to curly@e-card.bg |
||||
* fixed recognition of java-generated requests |
||||
thanks to matthew.lewis@syntegra.com |
||||
* code cleanup |
||||
|
||||
version 0.4.1 (beta) - Wed Aug 21 2002 |
||||
* fixed revocation |
||||
* added some colors |
||||
* thanks to curly@e-card.bg |
||||
|
||||
version 0.4.0 (beta) - Sun Aug 18 2002 |
||||
* works independent of OpenCA modules now |
||||
* some enhancements to functionality (e.g. export of key without |
||||
passwd) |
||||
* some smaller bugfixes in usability |
||||
* new specfile (thanks to oron@actcom.co.il) |
||||
|
||||
version 0.3.4 (beta) - Mon Jun 3 2002 |
||||
* fixed wrong templatedir when creating a new CA |
||||
|
||||
version 0.3.3 (beta) - Sun Jun 2 2002 |
||||
* fixed some minor bugs and typos |
||||
import of requests from ssh-sentinel should work now without problems |
||||
|
||||
version 0.3.2 (beta) - Sat May 11 2002 |
||||
* added parser for x509 extensions when viewing certificate details |
||||
|
||||
version 0.3.1 (beta) - Fri May 3 2002 |
||||
* added option to view complete certificate/request as text |
||||
|
||||
version 0.3.0 (beta) - Thu Apr 18 2002 |
||||
* added possibility to configure openssl |
||||
* fixed some minor bugs |
||||
|
||||
version 0.2.5 (beta) - Sun Apr 7 2002 |
||||
* improved usabilty and errorhandling |
||||
* fixed some minor bugs and typos |
||||
|
||||
version 0.2.4 (beta) - Sun Mar 31 2002 |
||||
* added possibilty to import PKCS#10 requests |
||||
* added function to delete a configured CA |
||||
|
||||
version 0.2.3 (beta) - Tue Mar 26 2002 |
||||
* fixed bug with expiration date defaults to 30 days when creating |
||||
a new CA |
||||
* change status to E in index.txt, if certificate is expired |
||||
@ -0,0 +1,30 @@ |
||||
1. Unpack the sources (seems like you got it already) |
||||
|
||||
2. Configure the following paths for your setup. These variables |
||||
are located in the file tinyca itself. |
||||
|
||||
@INC (location of the directory lib) |
||||
$init->{'opensslbin'} (location of your openssl binary) |
||||
$init->{'templatedir'} (location of the directory templates) |
||||
$init->{'zipbin'} (location of your zip binary) |
||||
$init->{'tarbin'} (location of your tar binary) |
||||
|
||||
3. If you want to have german/spanish/czech/swedish texts: |
||||
Generate the file tinyca.mo from po/de.po: |
||||
msgfmt po/de.po -o locale/de/LC_MESSAGES/tinyca.mo |
||||
msgfmt po/es.po -o locale/es/LC_MESSAGES/tinyca.mo |
||||
msgfmt po/cs.po -o locale/cs/LC_MESSAGES/tinyca.mo |
||||
msgfmt po/sv.po -o locale/sv/LC_MESSAGES/tinyca.mo |
||||
or even more simple: call make in the directory po/ |
||||
|
||||
If your locale is not set to german/spanish: |
||||
export LC_ALL=de_DE.UTF-8 |
||||
or |
||||
export LC_ALL=es_ES.UTF-8 |
||||
or |
||||
export LC_ALL=cs_CZ.UTF-8 |
||||
or |
||||
export LC_ALL=sv_SE.UTF-8 |
||||
before you call tinyca. |
||||
|
||||
4. Call tinyca2, use it and report bugs :-)) |
||||
@ -0,0 +1,9 @@ |
||||
#!/bin/bash |
||||
|
||||
mkdir -p locale/de/LC_MESSAGES |
||||
mkdir -p locale/es/LC_MESSAGES |
||||
mkdir -p locale/cs/LC_MESSAGES |
||||
|
||||
msgfmt po/de.po -o locale/de/LC_MESSAGES/tinyca2.mo |
||||
msgfmt po/es.po -o locale/es/LC_MESSAGES/tinyca2.mo |
||||
msgfmt po/cs.po -o locale/cs/LC_MESSAGES/tinyca2.mo |
||||
@ -0,0 +1,713 @@ |
||||
# Copyright (c) Stephan Martin <sm@sm-zone.net> |
||||
# |
||||
# $Id: CERT.pm,v 1.11 2006/06/28 21:50:41 sm Exp $ |
||||
# |
||||
# 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, USA. |
||||
|
||||
use strict; |
||||
|
||||
package CERT; |
||||
|
||||
use POSIX; |
||||
|
||||
sub new { |
||||
my $that = shift; |
||||
my $class = ref($that) || $that; |
||||
|
||||
my $self = {}; |
||||
|
||||
$self->{'OpenSSL'} = shift; |
||||
|
||||
bless($self, $class); |
||||
} |
||||
|
||||
# |
||||
# read certificates in directory into list |
||||
# |
||||
sub read_certlist { |
||||
my ($self, $certdir, $crlfile, $indexfile, $force, $main) = @_; |
||||
|
||||
my($f, $certlist, $crl, $modt, $parsed, $tmp, $t, $c, $p, @files); |
||||
|
||||
GUI::HELPERS::set_cursor($main, 1); |
||||
|
||||
$certlist = []; |
||||
|
||||
$modt = (stat($certdir))[9]; |
||||
|
||||
if(defined($self->{'lastread'}) && |
||||
($self->{'lastread'} >= $modt) && |
||||
not defined($force)) { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
return(0); |
||||
} |
||||
|
||||
$crl = $self->{'OpenSSL'}->parsecrl($crlfile, $force); |
||||
|
||||
opendir(DIR, $certdir) || do { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
$t = sprintf(_("Can't open Certificate directory: %s"), $certdir); |
||||
GUI::HELPERS::print_warning($t); |
||||
return(0); |
||||
}; |
||||
|
||||
while($f = readdir(DIR)) { |
||||
next if $f =~ /^\./; |
||||
push(@files, $f); |
||||
$c++; |
||||
} |
||||
|
||||
$main->{'barbox'}->pack_start($main->{'progress'}, 0, 0, 0); |
||||
$main->{'progress'}->show(); |
||||
foreach $f (@files) { |
||||
next if $f =~ /^\./; |
||||
|
||||
$f =~ s/\.pem//; |
||||
|
||||
$tmp = HELPERS::dec_base64($f); |
||||
next if not defined($tmp); |
||||
next if $tmp eq ""; |
||||
|
||||
if(defined($main)) { |
||||
$t = sprintf(_(" Read Certificate: %s"), $tmp); |
||||
GUI::HELPERS::set_status($main, $t); |
||||
$p += 100/$c; |
||||
if($p/100 <= 1) { |
||||
$main->{'progress'}->set_fraction($p/100); |
||||
while(Gtk2->events_pending) { |
||||
Gtk2->main_iteration; |
||||
} |
||||
} |
||||
} |
||||
|
||||
my $debugf = $certdir."/".$f.".pem"; |
||||
|
||||
$parsed = $self->{'OpenSSL'}->parsecert($crlfile, $indexfile, |
||||
$certdir."/".$f.".pem", $force); |
||||
|
||||
defined($parsed) || do { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
GUI::HELPERS::print_error(_("Can't read Certificate")); |
||||
}; |
||||
|
||||
$tmp .= "%".$parsed->{'STATUS'}; |
||||
|
||||
push(@{$certlist}, $tmp); |
||||
} |
||||
@{$certlist} = sort(@{$certlist}); |
||||
closedir(DIR); |
||||
|
||||
$self->{'certlist'} = $certlist; |
||||
|
||||
$self->{'lastread'} = time(); |
||||
|
||||
if(defined($main)) { |
||||
$main->{'progress'}->set_fraction(0); |
||||
$main->{'barbox'}->remove($main->{'progress'}); |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
} |
||||
|
||||
return(1); # got new list |
||||
} |
||||
|
||||
# |
||||
# get information for renewing a certifikate |
||||
# |
||||
sub get_renew_cert { |
||||
my ($self, $main, $opts, $box) = @_; |
||||
|
||||
my ($cert, $status, $t, $ca, $cadir); |
||||
|
||||
$box->destroy() if(defined($box)); |
||||
|
||||
if((not defined($opts->{'certfile'})) || |
||||
(not defined($opts->{'passwd'})) || |
||||
($opts->{'certfile'} eq '') || |
||||
($opts->{'passwd'} eq '')) { |
||||
|
||||
$cert = $main->{'certbrowser'}->selection_dn(); |
||||
|
||||
if(not defined($cert)) { |
||||
GUI::HELPERS::print_info(_("Please select a Certificate first")); |
||||
return; |
||||
} |
||||
|
||||
$ca = $main->{'certbrowser'}->selection_caname(); |
||||
$cadir = $main->{'certbrowser'}->selection_cadir(); |
||||
$status = $main->{'certbrowser'}->selection_status(); |
||||
|
||||
if($status eq _("VALID")) { |
||||
$t = sprintf( |
||||
_("Can't renew Certifikate with Status: %s\nPlease revoke the Certificate first"), |
||||
$status); |
||||
GUI::HELPERS::print_warning($t); |
||||
return; |
||||
} |
||||
|
||||
$opts->{'certname'} = HELPERS::enc_base64($cert); |
||||
$opts->{'reqname'} = $opts->{'certname'}; |
||||
$opts->{'certfile'} = $cadir."/certs/".$opts->{'certname'}.".pem"; |
||||
$opts->{'keyfile'} = $cadir."/keys/".$opts->{'certname'}.".pem"; |
||||
$opts->{'reqfile'} = $cadir."/req/".$opts->{'certname'}.".pem"; |
||||
|
||||
if((not -s $opts->{'certfile'}) || |
||||
(not -s $opts->{'keyfile'}) || |
||||
(not -s $opts->{'reqfile'})) { |
||||
$t = _("Key and Request are necessary for renewal of a Certificate\nRenewal is not possible!"); |
||||
GUI::HELPERS::print_warning($t); |
||||
return; |
||||
} |
||||
|
||||
$main->show_req_sign_dialog($opts); |
||||
return; |
||||
} |
||||
|
||||
$main->{'REQ'}->sign_req($main, $opts); |
||||
|
||||
return; |
||||
} |
||||
|
||||
# |
||||
# get information for revoking a certifikate |
||||
# |
||||
sub get_revoke_cert { |
||||
my ($self, $main, $opts, $box) = @_; |
||||
|
||||
my ($cert, $status, $t, $ca, $cadir); |
||||
|
||||
$box->destroy() if(defined($box)); |
||||
|
||||
if((not defined($opts->{'certfile'})) || |
||||
(not defined($opts->{'passwd'})) || |
||||
($opts->{'certfile'} eq '') || |
||||
($opts->{'passwd'} eq '')) { |
||||
$opts->{'certfile'} = $main->{'certbrowser'}->selection_fname(); |
||||
|
||||
if(not defined($opts->{'certfile'})) { |
||||
$t = _("Please select a Certificate first"); |
||||
GUI::HELPERS::print_info($t); |
||||
return; |
||||
} |
||||
|
||||
$ca = $main->{'certbrowser'}->selection_caname(); |
||||
$cadir = $main->{'certbrowser'}->selection_cadir(); |
||||
$cert = $main->{'certbrowser'}->selection_dn(); |
||||
$status = $main->{'certbrowser'}->selection_status(); |
||||
|
||||
if($status ne _("VALID")) { |
||||
$t = sprintf(_("Can't revoke Certifikate with Status: %s"), |
||||
$status); |
||||
GUI::HELPERS::print_warning($t); |
||||
return; |
||||
} |
||||
|
||||
$opts->{'certname'} = HELPERS::enc_base64($cert); |
||||
$opts->{'cert'} = $cert; |
||||
|
||||
$main->show_cert_revoke_dialog($opts); |
||||
return; |
||||
} |
||||
|
||||
$self->revoke_cert($main, $opts); |
||||
|
||||
return; |
||||
} |
||||
|
||||
# |
||||
# now really revoke the certificate |
||||
# |
||||
sub revoke_cert { |
||||
my ($self, $main, $opts) = @_; |
||||
|
||||
my($ca, $cadir, $ret, $t, $ext, $reason); |
||||
|
||||
$ca = $main->{'certbrowser'}->selection_caname(); |
||||
$cadir = $main->{'certbrowser'}->selection_cadir(); |
||||
|
||||
GUI::HELPERS::set_cursor($main, 1); |
||||
|
||||
if(defined($opts->{'reason'}) && $opts->{'reason'} ne '') { |
||||
$reason = $opts->{'reason'}; |
||||
} else { |
||||
$reason = 'none'; |
||||
} |
||||
|
||||
($ret, $ext) = $self->{'OpenSSL'}->revoke( |
||||
'config' => $main->{'CA'}->{$ca}->{'cnf'}, |
||||
'infile' => $cadir."/certs/".$opts->{'certname'}.".pem", |
||||
'pass' => $opts->{'passwd'}, |
||||
'reason' => $reason |
||||
); |
||||
|
||||
if($ret eq 1) { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
$t = _("Wrong CA password given\nRevoking the Certificate failed"); |
||||
GUI::HELPERS::print_warning($t, $ext); |
||||
delete($opts->{$_}) foreach(keys(%$opts)); |
||||
$opts = undef; |
||||
return; |
||||
} elsif($ret eq 2) { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
$t = _("CA Key not found\nRevoking the Certificate failed"); |
||||
GUI::HELPERS::print_warning($t, $ext); |
||||
delete($opts->{$_}) foreach(keys(%$opts)); |
||||
$opts = undef; |
||||
return; |
||||
} elsif($ret) { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
$t = _("Revoking the Certificate failed"); |
||||
GUI::HELPERS::print_warning($t, $ext); |
||||
delete($opts->{$_}) foreach(keys(%$opts)); |
||||
$opts = undef; |
||||
return; |
||||
} |
||||
|
||||
($ret, $ext) = $self->{'OpenSSL'}->newcrl( |
||||
'config' => $main->{'CA'}->{$ca}->{'cnf'}, |
||||
'pass' => $opts->{'passwd'}, |
||||
'crldays' => 365, |
||||
'outfile' => $cadir."/crl/crl.pem" |
||||
); |
||||
|
||||
if (not -s $cadir."/crl/crl.pem" || $ret) { |
||||
delete($opts->{$_}) foreach(keys(%$opts)); |
||||
$opts = undef; |
||||
|
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
GUI::HELPERS::print_error( |
||||
_("Generating a new Revocation List failed"), $ext); |
||||
} |
||||
|
||||
$self->{'OpenSSL'}->parsecrl( $cadir."/crl/crl.pem", 1); |
||||
|
||||
$self->reread_cert($main, $opts->{'cert'}); |
||||
|
||||
# force reread of certlist |
||||
$main->{'certbrowser'}->update($cadir."/certs", |
||||
$cadir."/crl/crl.pem", |
||||
$cadir."/index.txt", |
||||
0); |
||||
|
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
|
||||
delete($opts->{$_}) foreach(keys(%$opts)); |
||||
$opts = undef; |
||||
|
||||
return; |
||||
} |
||||
|
||||
# |
||||
# get name of certificatefile to delete |
||||
# |
||||
sub get_del_cert { |
||||
my ($self, $main) = @_; |
||||
|
||||
my($certname, $cert, $certfile, $status, $t, $cadir, $ca); |
||||
|
||||
$certfile = $main->{'certbrowser'}->selection_fname(); |
||||
|
||||
if(not defined $certfile) { |
||||
GUI::HELPERS::print_info(_("Please select a Certificate first")); |
||||
return; |
||||
} |
||||
|
||||
$ca = $main->{'certbrowser'}->selection_caname(); |
||||
$cadir = $main->{'certbrowser'}->selection_cadir(); |
||||
$cert = $main->{'certbrowser'}->selection_dn(); |
||||
$status = $main->{'certbrowser'}->selection_status(); |
||||
|
||||
$certname = HELPERS::enc_base64($cert); |
||||
|
||||
if($status eq _("VALID")) { |
||||
GUI::HELPERS::print_warning( |
||||
_("Can't delete VALID certificate!\nPlease revoke the Certificate first.")); |
||||
return; |
||||
} |
||||
|
||||
$main->show_del_confirm($certfile, 'cert'); |
||||
|
||||
return; |
||||
} |
||||
|
||||
# |
||||
# now really delete the certificatefile |
||||
# |
||||
sub del_cert { |
||||
my ($self, $main, $file) = @_; |
||||
|
||||
GUI::HELPERS::set_cursor($main, 1); |
||||
|
||||
unlink($file); |
||||
|
||||
my $cadir = $main->{'certbrowser'}->selection_cadir(); |
||||
|
||||
$main->{'certbrowser'}->update($cadir."/certs", |
||||
$cadir."/crl/crl.pem", |
||||
$cadir."/index.txt", |
||||
0); |
||||
|
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
|
||||
return; |
||||
} |
||||
|
||||
# |
||||
# get informations for exporting a certificate |
||||
# |
||||
sub get_export_cert { |
||||
my ($self, $main, $opts, $box) = @_; |
||||
|
||||
$box->destroy() if(defined($box)); |
||||
|
||||
my($ca, $t, $cn, $email, $cadir); |
||||
|
||||
if(not defined($opts)) { |
||||
$cn = $main->{'certbrowser'}->selection_cn(); |
||||
$email = $main->{'certbrowser'}->selection_email(); |
||||
|
||||
if(not defined $cn) { |
||||
GUI::HELPERS::print_info(_("Please select a Certificate first")); |
||||
return; |
||||
} |
||||
|
||||
$ca = $main->{'certbrowser'}->selection_caname(); |
||||
$cadir = $main->{'certbrowser'}->selection_cadir(); |
||||
|
||||
$opts->{'status'} = $main->{'certbrowser'}->selection_status(); |
||||
$opts->{'cert'} = $main->{'certbrowser'}->selection_dn(); |
||||
|
||||
$opts->{'certname'} = HELPERS::enc_base64($opts->{'cert'}); |
||||
$opts->{'certfile'} = $cadir."/certs/".$opts->{'certname'}.".pem"; |
||||
$opts->{'keyfile'} = $cadir."/keys/".$opts->{'certname'}.".pem"; |
||||
$opts->{'cafile'} = $cadir."/cacert.pem"; |
||||
|
||||
if (-f $cadir."/cachain.pem") { |
||||
$opts->{'cafile'} = $cadir."/cachain.pem"; |
||||
} |
||||
|
||||
if($opts->{'status'} ne _("VALID")) { |
||||
$t = _("Certificate seems not to be VALID"); |
||||
$t .= "\n"; |
||||
$t .= _("Export is not possible"); |
||||
GUI::HELPERS::print_warning($t); |
||||
return; |
||||
} |
||||
|
||||
$opts->{'parsed'} = $self->parse_cert($main, $opts->{'certname'}); |
||||
|
||||
if((defined($email)) && $email ne '' && $email ne ' ') { |
||||
$opts->{'outfile'} = "$main->{'exportdir'}/$email-cert.pem"; |
||||
}elsif((defined($cn)) && $cn ne '' && $cn ne ' ') { |
||||
$opts->{'outfile'} = "$main->{'exportdir'}/$cn-cert.pem"; |
||||
}else{ |
||||
$opts->{'outfile'} = "$main->{'exportdir'}/cert.pem"; |
||||
} |
||||
$opts->{'format'} = 'PEM'; |
||||
$opts->{'include'} = 0; |
||||
$opts->{'incfp'} = 0; |
||||
$opts->{'nopass'} = 0; |
||||
$opts->{'friendlyname'} = ''; |
||||
|
||||
$main->show_export_dialog($opts, 'cert'); |
||||
return; |
||||
} |
||||
|
||||
if((not defined($opts->{'outfile'})) || ($opts->{'outfile'} eq '')) { |
||||
$main->show_export_dialog($opts, 'cert'); |
||||
GUI::HELPERS::print_warning( |
||||
_("Please give at least the output file")); |
||||
return; |
||||
} |
||||
|
||||
if($opts->{'format'} eq 'P12') { |
||||
if(not -s $opts->{'keyfile'}) { |
||||
$t = _("Key is necessary for export as PKCS#12"); |
||||
$t .= "\n"; |
||||
$t .= _("Export is not possible!"); |
||||
GUI::HELPERS::print_warning($t); |
||||
return; |
||||
} |
||||
|
||||
if((not defined($opts->{'p12passwd'})) && |
||||
(not $opts->{'nopass'})) { |
||||
$opts->{'includeca'} = 1; |
||||
$main->show_p12_export_dialog($opts, 'cert'); |
||||
return; |
||||
} |
||||
} elsif(($opts->{'format'} eq 'ZIP') || ($opts->{'format'} eq 'TAR')) { |
||||
if(not -s $opts->{'keyfile'}) { |
||||
$t = sprintf( |
||||
_("Key is necessary for export as %s"), $opts->{'format'}); |
||||
$t .= "\n"; |
||||
$t .= _("Export is not possible!"); |
||||
GUI::HELPERS::print_warning($t); |
||||
return; |
||||
} |
||||
} |
||||
|
||||
$self->export_cert($main, $opts); #FIXME no need for two functions |
||||
|
||||
return; |
||||
} |
||||
|
||||
|
||||
# |
||||
# now really export the certificate |
||||
# |
||||
sub export_cert { |
||||
my ($self, $main, $opts) = @_; |
||||
|
||||
my($ca, $t, $out, $ret, $ext); |
||||
|
||||
GUI::HELPERS::set_cursor($main, 1); |
||||
|
||||
$ca = $main->{'CA'}->{'actca'}; |
||||
|
||||
if($opts->{'format'} eq 'PEM') { |
||||
if($opts->{'incfp'}) { |
||||
$out = ''; |
||||
$out .= "Fingerprint (MD5): $opts->{'parsed'}->{'FINGERPRINTMD5'}\n"; |
||||
$out .= "Fingerprint (SHA1): $opts->{'parsed'}->{'FINGERPRINTSHA1'}\n\n"; |
||||
} else { |
||||
$out = ''; |
||||
} |
||||
|
||||
$out .= $opts->{'parsed'}->{'PEM'}; |
||||
|
||||
if($opts->{'include'}) { |
||||
open(IN, "<$opts->{'keyfile'}") || do { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
$t = sprintf(_("Can't open Certificate file: %s: %s"), |
||||
$opts->{'keyfile'}, $!); |
||||
return; |
||||
}; |
||||
$out .= "\n"; |
||||
$out .= $_ while(<IN>); |
||||
close(IN); |
||||
} |
||||
} elsif ($opts->{'format'} eq 'DER') { |
||||
$out = $opts->{'parsed'}->{'DER'}; |
||||
} elsif ($opts->{'format'} eq 'TXT') { |
||||
$out = $opts->{'parsed'}->{'TEXT'}; |
||||
} elsif ($opts->{'format'} eq 'P12') { |
||||
unlink($opts->{'outfile'}); |
||||
($ret, $ext) = $self->{'OpenSSL'}->genp12( |
||||
certfile => $opts->{'certfile'}, |
||||
keyfile => $opts->{'keyfile'}, |
||||
cafile => $opts->{'cafile'}, |
||||
outfile => $opts->{'outfile'}, |
||||
passwd => $opts->{'passwd'}, |
||||
p12passwd => $opts->{'p12passwd'}, |
||||
includeca => $opts->{'includeca'}, |
||||
nopass => $opts->{'nopass'}, |
||||
friendly => $opts->{'friendlyname'} |
||||
); |
||||
|
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
|
||||
if($ret eq 1) { |
||||
$t = "Wrong password given\nDecrypting Key failed\nGenerating PKCS#12 failed"; |
||||
GUI::HELPERS::print_warning($t, $ext); |
||||
return; |
||||
} elsif($ret || (not -s $opts->{'outfile'})) { |
||||
$t = _("Generating PKCS#12 failed"); |
||||
GUI::HELPERS::print_warning($t, $ext); |
||||
return; |
||||
} |
||||
|
||||
$main->{'exportdir'} = HELPERS::write_export_dir($main, |
||||
$opts->{'outfile'}); |
||||
|
||||
$t = sprintf(_("Certificate and Key successfully exported to %s"), |
||||
$opts->{'outfile'}); |
||||
GUI::HELPERS::print_info($t, $ext); |
||||
return; |
||||
|
||||
} elsif (($opts->{'format'} eq "ZIP") || ($opts->{'format'} eq "TAR")) { |
||||
|
||||
my $tmpcert = "$main->{'tmpdir'}/cert.pem"; |
||||
my $tmpkey = "$main->{'tmpdir'}/key.pem"; |
||||
my $tmpcacert = "$main->{'tmpdir'}/cacert.pem"; |
||||
|
||||
open(OUT, ">$tmpcert") || do { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
$t = sprintf(_("Can't create temporary file: %s: %s"), |
||||
$tmpcert, $!); |
||||
GUI::HELPERS::print_warning($t); |
||||
return; |
||||
}; |
||||
print OUT $opts->{'parsed'}->{'PEM'}; |
||||
close OUT; |
||||
|
||||
# store key in temporary location |
||||
{ |
||||
open(IN, "<$opts->{'keyfile'}") || do { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
$t = sprintf(_("Can't read Key file: %s: %s"), $tmpcert, $!); |
||||
GUI::HELPERS::print_warning($t); |
||||
return; |
||||
}; |
||||
my @key = <IN>; |
||||
close IN; |
||||
|
||||
open(OUT, ">$tmpkey") || do { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
$t = sprintf(_("Can't create temporary file: %s: %s"), |
||||
$tmpcert, $!); |
||||
GUI::HELPERS::print_warning($t); |
||||
return; |
||||
}; |
||||
print OUT @key; |
||||
close OUT; |
||||
} |
||||
|
||||
# store cacert in temporary location |
||||
{ |
||||
open(IN, "<$opts->{'cafile'}") || do { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
GUI::HELPERS::print_warning(_("Can't read CA certificate")); |
||||
return; |
||||
}; |
||||
my @cacert = <IN>; |
||||
close IN; |
||||
|
||||
open(OUT, ">$tmpcacert") || do { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
GUI::HELPERS::print_warning(_("Can't create temporary file")); |
||||
return; |
||||
}; |
||||
print OUT @cacert; |
||||
close OUT; |
||||
} |
||||
|
||||
unlink($opts->{'outfile'}); |
||||
if($opts->{'format'} eq "ZIP") { |
||||
system($main->{'init'}->{'zipbin'}, '-j', $opts->{'outfile'}, |
||||
$tmpcacert, $tmpkey, $tmpcert); |
||||
my $ret = $? >> 8; |
||||
} elsif ($opts->{'format'} eq "TAR") { |
||||
system($main->{'init'}->{'tarbin'}, 'cfv', $opts->{'outfile'}, |
||||
$tmpcacert, $tmpkey, $tmpcert); |
||||
} |
||||
|
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
|
||||
if(not -s $opts->{'outfile'} || $ret) { |
||||
GUI::HELPERS::print_warning( |
||||
sprintf(_("Generating %s file failed"), $opts->{'format'}) |
||||
); |
||||
} else { |
||||
$main->{'exportdir'} = HELPERS::write_export_dir($main, |
||||
$opts->{'outfile'}); |
||||
|
||||
$t = sprintf( |
||||
_("Certificate and Key successfully exported to %s"), |
||||
$opts->{'outfile'}); |
||||
GUI::HELPERS::print_info($t); |
||||
unlink($tmpcacert); |
||||
unlink($tmpcert); |
||||
unlink($tmpkey); |
||||
|
||||
return; |
||||
} |
||||
|
||||
} else { |
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
$t = sprintf(_("Invalid Format for export_cert(): %s"), |
||||
$opts->{'format'}); |
||||
GUI::HELPERS::print_warning($t); |
||||
return; |
||||
} |
||||
|
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
|
||||
open(OUT, ">$opts->{'outfile'}") || do { |
||||
GUI::HELPERS::print_warning(_("Can't open output file: %s: %s"), |
||||
$opts->{'outfile'}, $!); |
||||
return; |
||||
}; |
||||
|
||||
print OUT $out; |
||||
close OUT; |
||||
|
||||
$main->{'exportdir'} = HELPERS::write_export_dir($main, |
||||
$opts->{'outfile'}); |
||||
|
||||
$t = sprintf(_("Certificate successfully exported to: %s"), |
||||
$opts->{'outfile'}); |
||||
GUI::HELPERS::print_info($t); |
||||
|
||||
return; |
||||
} |
||||
|
||||
sub reread_cert { |
||||
my ($self, $main, $name) = @_; |
||||
|
||||
my ($parsed, $tmp); |
||||
|
||||
GUI::HELPERS::set_cursor($main, 1); |
||||
|
||||
$name = HELPERS::enc_base64($name); |
||||
|
||||
$parsed = $self->parse_cert($main, $name, 1); |
||||
|
||||
# print STDERR "DEBUG: status $parsed->{'STATUS'}\n"; |
||||
|
||||
foreach(@{$self->{'certlist'}}) { |
||||
if(/^$name%/) { |
||||
; #delete |
||||
} else { |
||||
push(@{$tmp}, $_); |
||||
} |
||||
} |
||||
push(@{$tmp}, $name."%".$parsed->{'STATUS'}); |
||||
@{$tmp} = sort(@{$tmp}); |
||||
|
||||
delete($self->{'certlist'}); |
||||
$self->{'certlist'} = $tmp; |
||||
|
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
|
||||
return; |
||||
} |
||||
|
||||
sub parse_cert { |
||||
my ($self, $main, $name, $force) = @_; |
||||
|
||||
my($ca, $certfile, $x509, $parsed); |
||||
|
||||
GUI::HELPERS::set_cursor($main, 1); |
||||
|
||||
$ca = $main->{'CA'}->{'actca'}; |
||||
|
||||
if($name eq 'CA') { |
||||
$certfile = $main->{'CA'}->{$ca}->{'dir'}."/cacert.pem"; |
||||
} else { |
||||
$certfile = $main->{'CA'}->{$ca}->{'dir'}."/certs/".$name.".pem"; |
||||
} |
||||
|
||||
$parsed = $self->{'OpenSSL'}->parsecert( |
||||
$main->{'CA'}->{$ca}->{'dir'}."/crl/crl.pem", |
||||
$main->{'CA'}->{$ca}->{'dir'}."/index.txt", |
||||
$certfile, |
||||
$force |
||||
); |
||||
|
||||
GUI::HELPERS::set_cursor($main, 0); |
||||
|
||||
return($parsed); |
||||
} |
||||
|
||||
1 |
||||
File diff suppressed because it is too large
Load Diff
@ -0,0 +1,173 @@ |
||||
# Copyright (c) Stephan Martin <sm@sm-zone.net> |
||||
# |
||||
# $Id: CALLBACK.pm,v 1.6 2006/06/28 21:50:42 sm Exp $ |
||||
# |
||||
# 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, USA. |
||||
|
||||
use strict; |
||||
package GUI::CALLBACK; |
||||
|
||||
use POSIX; |
||||
|
||||
# |
||||
# fill given var-reference with text from entry |
||||
# |
||||
sub entry_to_var { |
||||
my ($widget, $entry, $var, $box, $words) = @_; |
||||
|
||||
if(defined($words)) { |
||||
$$var = $words->{$entry->get_text()}; |
||||
}else{ |
||||
$$var = $entry->get_text(); |
||||
} |
||||
|
||||
if(defined($box)) { |
||||
$box->{'button_ok'}->set_sensitive(1); |
||||
$box->{'button_apply'}->set_sensitive(1); |
||||
} |
||||
|
||||
return; |
||||
} |
||||
|
||||
# |
||||
# fill given var-reference with text from entry subjectAltName |
||||
# and set senitivity of togglebuttons |
||||
# |
||||
sub entry_to_var_san { |
||||
my ($widget, $entry, $var, $box, $words, $radio1, $radio2, $radio3, $radio4) = @_; |
||||
|
||||
if(defined($words)) { |
||||
if(my $tmp = $words->{$entry->get_text()}) { |
||||
$$var = $tmp; |
||||
} else { |
||||
$$var = $entry->get_text(); |
||||
} |
||||
#print STDERR "DEBUG: var: $$var\n"; |
||||
if($$var eq 'user') { |
||||
#print STDERR "set sensitive(1)\n"; |
||||
$radio1->set_sensitive(1) if(defined($radio1)); |
||||
$radio2->set_sensitive(1) if(defined($radio2)); |
||||
$radio3->set_sensitive(1) if(defined($radio3)); |
||||
$radio4->set_sensitive(1) if(defined($radio4)); |
||||
}else{ |
||||
#print STDERR "DEBUG: set sensitive(0)\n"; |
||||
#print STDERR "DEBUG: r1 $radio1 r2 $radio2 r3 $radio3 r4 $radio4\n"; |
||||
$radio1->set_sensitive(0) if(defined($radio1)); |
||||
$radio2->set_sensitive(0) if(defined($radio2)); |
||||
$radio3->set_sensitive(0) if(defined($radio3)); |
||||
$radio4->set_sensitive(0) if(defined($radio4)); |
||||
} |
||||
}else{ |
||||
$$var = $entry->get_text(); |
||||
} |
||||
|
||||
if(defined($box)) { |
||||
$box->{'button_ok'}->set_sensitive(1); |
||||
$box->{'button_apply'}->set_sensitive(1); |
||||
} |
||||
|
||||
return; |
||||
} |
||||
|
||||
# |
||||
# fill given var-reference with text from entry subjectAltName |
||||
# and set senitivity of togglebuttons |
||||
# |
||||
sub entry_to_var_key { |
||||
my ($widget, $entry, $var, $box, $words, $radio1, $radio2, $radio3) = @_; |
||||
|
||||
if(defined($words)) { |
||||
if(my $tmp = $words->{$entry->get_text()}) { |
||||
$$var = $tmp; |
||||
} else { |
||||
$$var = $entry->get_text(); |
||||
} |
||||
if(($$var ne '') && ($$var ne 'none')) { |
||||
$radio1->set_sensitive(1) if(defined($radio1)); |
||||
$radio2->set_sensitive(1) if(defined($radio2)); |
||||
$radio3->set_sensitive(1) if(defined($radio3)); |
||||
}else{ |
||||
$radio1->set_sensitive(0) if(defined($radio1)); |
||||
$radio2->set_sensitive(0) if(defined($radio2)); |
||||
$radio3->set_sensitive(0) if(defined($radio3)); |
||||
} |
||||
}else{ |
||||
$$var = $entry->get_text(); |
||||
} |
||||
|
||||
if(defined($box)) { |
||||
$box->{'button_ok'}->set_sensitive(1); |
||||
$box->{'button_apply'}->set_sensitive(1); |
||||
} |
||||
|
||||
return; |
||||
} |
||||
|
||||
# |
||||
# fill given var-reference with value from togglebutton |
||||
# |
||||
sub toggle_to_var { |
||||
my ($button, $var, $value, $outfileref, $formatref, $fileentry, $pass1, |
||||
$pass2) = @_; |
||||
|
||||
$$var = $value; |
||||
|
||||
if(defined($outfileref) && defined($formatref)) { |
||||
if($$outfileref =~ s/\.(pem|der|txt|p12|zip|tar)$//i) { |
||||
$$outfileref .= "." . lc $$formatref; |
||||
# something seem broken, need tmp var |
||||
my $tmp = $$outfileref; |
||||
$fileentry->set_text($tmp); |
||||
} |
||||
} |
||||
if(defined($pass1) && defined($pass2)) { |
||||
if($$formatref eq "PEM") { |
||||
$pass1->set_sensitive(1); |
||||
$pass2->set_sensitive(1); |
||||
} elsif ($$formatref eq "DER") { |
||||
$pass1->set_sensitive(0); |
||||
$pass2->set_sensitive(0); |
||||
} elsif ($$formatref eq "P12") { |
||||
$pass1->set_sensitive(0); |
||||
$pass2->set_sensitive(0); |
||||
} elsif ($$formatref eq "ZIP") { |
||||
$pass1->set_sensitive(0); |
||||
$pass2->set_sensitive(0); |
||||
} elsif ($$formatref eq "TAR") { |
||||
$pass1->set_sensitive(0); |
||||
$pass2->set_sensitive(0); |
||||
} |
||||
} |
||||
return; |
||||
} |
||||
|
||||
# |
||||
# fill given var-reference with value from togglebutton |
||||
# |
||||
sub toggle_to_var_pref { |
||||
my ($button, $var, $value, $box) = @_; |
||||
|
||||
$$var = $value; |
||||
|
||||
if(defined($box) && defined($box->{'nb'}->get_current_page())) { |
||||
$box->{'button_ok'}->set_sensitive(1); |
||||
$box->{'button_apply'}->set_sensitive(1); |
||||
} |
||||
|
||||
return; |
||||
} |
||||
|
||||
1 |
||||
|
||||
@ -0,0 +1,479 @@ |
||||
# Copyright (c) Stephan Martin <sm@sm-zone.net> |
||||
# |
||||
# $Id: HELPERS.pm,v 1.6 2006/06/28 21:50:42 sm Exp $ |
||||
# |
||||
# 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, USA. |
||||
|
||||
use strict; |
||||
package GUI::HELPERS; |
||||
|
||||
use POSIX; |
||||
|
||||
# |
||||
# Error message box, kills application |
||||
# |
||||
sub print_error { |
||||
my ($t, $ext) = @_; |
||||
|
||||
my ($box, $button, $dbutton, $expander, $text, $scrolled, $buffer); |
||||
|
||||
$button = Gtk2::Button->new_from_stock('gtk-ok'); |
||||
$button->signal_connect('clicked', sub { HELPERS::exit_clean(1) }); |
||||
$button->can_default(1); |
||||
|
||||
$box = Gtk2::MessageDialog->new( |
||||
undef, [qw/destroy-with-parent modal/], 'error', 'none', $t); |
||||
$box->set_default_size(600, 0); |
||||
$box->set_resizable(1); |
||||
|
||||
if(defined($ext)) { |
||||
$buffer = Gtk2::TextBuffer->new(); |
||||
$buffer->set_text($ext); |
||||
|
||||
$text = Gtk2::TextView->new_with_buffer($buffer); |
||||
$text->set_editable(0); |
||||
$text->set_wrap_mode('word'); |
||||
|
||||
$scrolled = Gtk2::ScrolledWindow->new(undef, undef); |
||||
$scrolled->set_policy('never', 'automatic'); |
||||
$scrolled->set_shadow_type('etched-in'); |
||||
$scrolled->add($text); |
||||
|
||||
$expander = Gtk2::Expander->new(_("Command Details")); |
||||
$expander->add($scrolled); |
||||
$box->vbox->add($expander); |
||||
} |
||||
|
||||
$box->add_action_widget($button, 0); |
||||
|
||||
$box->show_all(); |
||||
} |
||||
|
||||
# |
||||
# Warning message box |
||||
# |
||||
sub print_warning { |
||||
my ($t, $ext) = @_; |
||||
|
||||
my ($box, $button, $dbutton, $expander, $text, $scrolled, $buffer); |
||||
|
||||
$button = Gtk2::Button->new_from_stock('gtk-ok'); |
||||
$button->signal_connect('clicked', sub { $box->destroy() }); |
||||
$button->can_default(1); |
||||
|
||||
$box = Gtk2::MessageDialog->new( |
||||
undef, [qw/destroy-with-parent modal/], 'warning', 'none', $t); |
||||
$box->set_default_size(600, 0); |
||||
$box->set_resizable(1); |
||||
|
||||
if(defined($ext)) { |
||||
$buffer = Gtk2::TextBuffer->new(); |
||||
$buffer->set_text($ext); |
||||
|
||||
$text = Gtk2::TextView->new_with_buffer($buffer); |
||||
$text->set_editable(0); |
||||
$text->set_wrap_mode('word'); |
||||
|
||||
$scrolled = Gtk2::ScrolledWindow->new(undef, undef); |
||||
$scrolled->set_policy('never', 'automatic'); |
||||
$scrolled->set_shadow_type('etched-in'); |
||||
$scrolled->add($text); |
||||
|
||||
$expander = Gtk2::Expander->new(_("Command Details")); |
||||
$expander->add($scrolled); |
||||
$box->vbox->add($expander); |
||||
} |
||||
$box->add_action_widget($button, 0); |
||||
|
||||
$box->show_all(); |
||||
|
||||
return; |
||||
} |
||||
|
||||
# |
||||
# Info message box |
||||
# |
||||
sub print_info { |
||||
my ($t, $ext) = @_; |
||||
|
||||
my ($box, $button, $dbutton, $buffer, $text, $scrolled, $expander); |
||||
|
||||
$button = Gtk2::Button->new_from_stock('gtk-ok'); |
||||
$button->signal_connect('clicked', sub { $box->destroy() }); |
||||
$button->can_default(1); |
||||
|
||||
$box = Gtk2::MessageDialog->new( |
||||
undef, [qw/destroy-with-parent modal/], 'info', 'none', $t); |
||||
$box->set_default_size(600, 0); |
||||
$box->set_resizable(1); |
||||
|
||||
if(defined($ext)) { |
||||
$buffer = Gtk2::TextBuffer->new(); |
||||
$buffer->set_text($ext); |
||||
|
||||
$text = Gtk2::TextView->new_with_buffer($buffer); |
||||
$text->set_editable(0); |
||||
$text->set_wrap_mode('word'); |
||||
|
||||
$scrolled = Gtk2::ScrolledWindow->new(undef, undef); |
||||
$scrolled->set_policy('never', 'automatic'); |
||||
$scrolled->set_shadow_type('etched-in'); |
||||
$scrolled->add($text); |
||||
|
||||
$expander = Gtk2::Expander->new(_("Command Details")); |
||||
$expander->add($scrolled); |
||||
$box->vbox->add($expander); |
||||
} |
||||
$box->add_action_widget($button, 0); |
||||
|
||||
$box->show_all(); |
||||
|
||||
return; |
||||
} |
||||
|
||||
# |
||||
# create standard dialog box |
||||
# |
||||
sub dialog_box { |
||||
my ($title, $text, $button1, $button2) = @_; |
||||
|
||||
my $box = Gtk2::Dialog->new($title, undef, ["destroy-with-parent"]); |
||||
|
||||
$box->add_action_widget($button1, 0); |
||||
|
||||
if(defined($button2)) { |
||||
$box->add_action_widget($button2, 0); |
||||
$box->action_area->set_layout('spread'); |
||||
} |
||||
|
||||
if(defined($text)) { |
||||
my $label = create_label($text, 'center', 0, 1); |
||||
$box->vbox->pack_start($label, 0, 0, 0); |
||||
} |
||||
|
||||
$box->signal_connect(response => sub { $box->destroy }); |
||||
|
||||
return($box); |
||||
} |
||||
|
||||
# |
||||
# create standard label |
||||
# |
||||
sub create_label { |
||||
my ($text, $mode, $wrap, $bold) = @_; |
||||
|
||||
$text = "<b>$text</b>" if($bold); |
||||
|
||||
my $label = Gtk2::Label->new($text); |
||||
|
||||
$label->set_justify($mode); |
||||
if($mode eq 'center') { |
||||
$label->set_alignment(0.5, 0.5); |
||||
}elsif($mode eq 'left') { |
||||
$label->set_alignment(0, 0); |
||||
}elsif($mode eq 'right') { |
||||
$label->set_alignment(1, 1); |
||||
} |
||||
|
||||
$label->set_line_wrap($wrap); |
||||
|
||||
$label->set_markup($text) if($bold); |
||||
|
||||
return($label); |
||||
} |
||||
|
||||
# |
||||
# write two labels to table |
||||
# |
||||
sub label_to_table { |
||||
my ($key, $val, $table, $row, $mode, $wrap, $bold) = @_; |
||||
|
||||
my ($label, $entry); |
||||
|
||||
$label = create_label($key, $mode, $wrap, $bold); |
||||
$label->set_padding(20, 0); |
||||
$table->attach_defaults($label, 0, 1, $row, $row+1); |
||||
|
||||
$label = create_label($val, $mode, $wrap, $bold); |
||||
$label->set_padding(20, 0); |
||||
$table->attach_defaults($label, 1, 2, $row, $row+1); |
||||
|
||||
$row++; |
||||
$table->resize($row, 2); |
||||
|
||||
return($row); |
||||
} |
||||
|
||||
# |
||||
# write label and entry to table |
||||
# |
||||
sub entry_to_table { |
||||
my ($text, $var, $table, $row, $visibility, $box) = @_; |
||||
|
||||
my ($label, $entry); |
||||
|
||||
$label = create_label($text, 'left', 0, 0); |
||||
$table->attach_defaults($label, 0, 1, $row, $row+1); |
||||
|
||||
$entry = Gtk2::Entry->new(); |
||||
$entry->set_text($$var) if(defined($$var)); |
||||
|
||||
$table->attach_defaults($entry, 1, 2, $row, $row+1); |
||||
$entry->signal_connect('changed' => |
||||
sub {GUI::CALLBACK::entry_to_var($entry, $entry, $var, $box)} ); |
||||
$entry->set_visibility($visibility); |
||||
|
||||
return($entry); |
||||
} |
||||
|
||||
# |
||||
# sort the table by the clicked column |
||||
# |
||||
sub sort_clist { |
||||