Agenten Erstellung automatische Email
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Agenten Erstellung automatische Email
Hallo zusammen,
zurzeit habe ich das Ziel bei der Erstellung eines Agenten ihm eine automatische Email zuzusenden, mit seinem Login und einem PW.
Meine Idee war es die Datei "User.pm" im Verzeichnis /opt/otrs/Kernel/System zu erweitern, ab Zeile 382 der Code Block Bereich "sub UserAdd".
Undzwar wollte ich ganz unten nach "return User ID" Code selber definieren, der dafür sorgt, dass dem erstellten Agenten eine automatische Mail zukommt.
# set password
$Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );
# set email address
$Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );
# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
return $UserID;
#send email
Unter #sendmail soll der Code folgen.
Erreichen wollte ich dies mithilfe der Datei "Email.pm" welche auch im Verzeichnis /opt/otrs/Kernel/System liegt.
Mithilfe dieses Code Blockes aus "Email.pm"
my $Sent = $SendObject->Send(
From => 'me@example.com',
To => 'friend@example.com',
Cc => 'Some Customer B <customer-b@example.com>', # not required
ReplyTo => 'Some Customer B <customer-b@example.com>', # not required, is possible to use 'Reply-To' instead
Subject => 'Some words!',
Charset => 'iso-8859-15',
MimeType => 'text/plain', # "text/plain" or "text/html"
Body => 'Some nice text',
InReplyTo => '<somemessageid-2@example.com>',
References => '<somemessageid-1@example.com> <somemessageid-2@example.com>',
Loop => 1, # not required, removes smtp from).
Angepasst an das System sollte der Code ungefährt so aussehen:
#send email
my $Sent = $Self->{SendmailObject}->Send(
From => $Param{From},
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
);
Jedoch gibt es beim Verändern der Dateien immer Fehler.
Wollte fragen ob jemand weiß womit das zusammenhängt und ob es überhaupt der richtige Weg ist, dass Ziel so zu erreichen.
Otrs läuft auf Debian 7.4.
PS: Weiß den Variablen Namen, in der die Admin Email hinterlegt ist?
MfG
Marco
zurzeit habe ich das Ziel bei der Erstellung eines Agenten ihm eine automatische Email zuzusenden, mit seinem Login und einem PW.
Meine Idee war es die Datei "User.pm" im Verzeichnis /opt/otrs/Kernel/System zu erweitern, ab Zeile 382 der Code Block Bereich "sub UserAdd".
Undzwar wollte ich ganz unten nach "return User ID" Code selber definieren, der dafür sorgt, dass dem erstellten Agenten eine automatische Mail zukommt.
# set password
$Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );
# set email address
$Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );
# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
return $UserID;
#send email
Unter #sendmail soll der Code folgen.
Erreichen wollte ich dies mithilfe der Datei "Email.pm" welche auch im Verzeichnis /opt/otrs/Kernel/System liegt.
Mithilfe dieses Code Blockes aus "Email.pm"
my $Sent = $SendObject->Send(
From => 'me@example.com',
To => 'friend@example.com',
Cc => 'Some Customer B <customer-b@example.com>', # not required
ReplyTo => 'Some Customer B <customer-b@example.com>', # not required, is possible to use 'Reply-To' instead
Subject => 'Some words!',
Charset => 'iso-8859-15',
MimeType => 'text/plain', # "text/plain" or "text/html"
Body => 'Some nice text',
InReplyTo => '<somemessageid-2@example.com>',
References => '<somemessageid-1@example.com> <somemessageid-2@example.com>',
Loop => 1, # not required, removes smtp from).
Angepasst an das System sollte der Code ungefährt so aussehen:
#send email
my $Sent = $Self->{SendmailObject}->Send(
From => $Param{From},
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
);
Jedoch gibt es beim Verändern der Dateien immer Fehler.
Wollte fragen ob jemand weiß womit das zusammenhängt und ob es überhaupt der richtige Weg ist, dass Ziel so zu erreichen.
Otrs läuft auf Debian 7.4.
PS: Weiß den Variablen Namen, in der die Admin Email hinterlegt ist?
MfG
Marco
Last edited by MarcoB106 on 19 Feb 2015, 12:27, edited 2 times in total.
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
Welche Fehler gibt es denn?
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Beim Zugreifen auf die Website erscheint der "Internal Server Error".
Und im Apache Error log steht:
Traceback (6785):
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 193
Module: /opt/otrs/bin/cgi-bin/index.pl (unknown version) Line: 49
[Tue Feb 17 11:05:11 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 11:05:12 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/Modules/AdminUser.pm line 315.
[Tue Feb 17 11:05:17 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/Modules/AdminUser.pm line 315.
[Tue Feb 17 11:05:21 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 11:06:27 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 11:06:28 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 11:31:44 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 11:31:45 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 487, near ")
return"
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 11:32:00 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 487, near ")
return"
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 11:32:01 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Das Ende der Funktion sub UserAdd() sieht ergänzt wie folgt aus :
# check if user exists
if ( !$UserID ) {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Unable to create User: '$Param{UserLogin}' ($Param{ChangeUserID})!",
);
return;
}
# log notice
$Self->{LogObject}->Log(
Priority => 'notice',
Message =>
"User: '$Param{UserLogin}' ID: '$UserID' created successfully ($Param{ChangeUserID})!",
);
# set password
$Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );
# set email address
$Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );
# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
#send email
my $Sent = $Self->{SendmailObject}->Send(
From => $Param{From},
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
)
return $UserID;
}
Und im Apache Error log steht:
Traceback (6785):
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 193
Module: /opt/otrs/bin/cgi-bin/index.pl (unknown version) Line: 49
[Tue Feb 17 11:05:11 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 11:05:12 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/Modules/AdminUser.pm line 315.
[Tue Feb 17 11:05:17 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/Modules/AdminUser.pm line 315.
[Tue Feb 17 11:05:21 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 11:06:27 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 11:06:28 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 11:31:44 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 11:31:45 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 487, near ")
return"
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 11:32:00 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 487, near ")
return"
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 11:32:01 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Das Ende der Funktion sub UserAdd() sieht ergänzt wie folgt aus :
# check if user exists
if ( !$UserID ) {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Unable to create User: '$Param{UserLogin}' ($Param{ChangeUserID})!",
);
return;
}
# log notice
$Self->{LogObject}->Log(
Priority => 'notice',
Message =>
"User: '$Param{UserLogin}' ID: '$UserID' created successfully ($Param{ChangeUserID})!",
);
# set password
$Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );
# set email address
$Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );
# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
#send email
my $Sent = $Self->{SendmailObject}->Send(
From => $Param{From},
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
)
return $UserID;
}
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
Du musst die Variable $ContentType deklarieren und belegen. In etwa so:
P.S.: Kannst Du für Code bitte die
Code: Select all
my $ContentType = 'text/plain';
Code: Select all
-Tags verwenden. Das macht das Ganze besser lesbar...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Erstmal vielen Dank für die Hilfe!
Die Fehlermeldung tritt nun nichtmehr auf
, jedoch wird beim erstellen eines Agenten durch den Admin Bereich keine automatische Mail an ihn gesendet.
Der Code sieht angepasst wie folgt aus :
Sind das vielleicht nicht die passenden Variablen + Attribute für "From" und "To" ?
MfG
Marco
Die Fehlermeldung tritt nun nichtmehr auf

Der Code sieht angepasst wie folgt aus :
Code: Select all
# set email address
$Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );
# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
#send email
my $ContentType = 'text/plain';
my $Sent = $Self->{SendmailObject}->Send(
From => $Param{From},
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
)
Sind das vielleicht nicht die passenden Variablen + Attribute für "From" und "To" ?
MfG
Marco
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
Statt $Param{From} solltest Du $Self->{ConfigObject}->Get('AdminEmail') oder noch besser $Self->{ConfigObject}->Get('NotificationSenderEmail') nehmen. Und nach dem schließenden ")" fehlt noch ein";"
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Wieder vielen Dank für die schnelle Antwort.
Beim ändern des Quellcodes tritt keine Fehlermeldung auf, jedoch wird beim erstellen trotzdem keine Mail gesendet.
Der Quellcode:
Ist die Variable $Param{UserEmail} passend, für einen erstellen Admin account?
Beim ändern des Quellcodes tritt keine Fehlermeldung auf, jedoch wird beim erstellen trotzdem keine Mail gesendet.
Der Quellcode:
Code: Select all
# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
return $UserID;
#send email
my $ContentType = 'text/plain';
my $Sent = $Self->{SendmailObject}->Send(
From => $Self->{ConfigObject}->Get('NotificationSenderEmail'),
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
);
Ist die Variable $Param{UserEmail} passend, für einen erstellen Admin account?
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
Das "return $UserID" muss natürlich *nach* dem Email-Versand kommen...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Danke für die Antwort! 
Die automatische Mail wird beim erstellen trotzdem noch nicht generiert.

Code: Select all
#send email
my $ContentType = 'text/plain';
my $Sent = $Self->{SendmailObject}->Send(
From => $Self->{ConfigObject}->Get('NotificationSenderEmail'),
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
);
return $UserID;
}
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
Irgendwelche Fehler? Schau mal ins Webserver log und ins OTRS log...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Beim Klicken auf Übermitteln, wenn man damit abschließen möchte den User zu erstellen tritt der "Internal Server Error" 500 auf.
Trotz des Fehlers wird der User angelegt, die Email jedoch nicht versand.
Das ist der Fehler des Apache - Error logs.
my "
Global symbol "$Sent" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 493.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 494.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 495.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 496.
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 497.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 498.
Can't use global @_ in "my" at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 524, near "= @_"
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 528.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 529.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 592, near "}"
/opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm has too many errors.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 13:47:55 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492, near ")
my "
Global symbol "$Sent" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 493.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 494.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 495.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 496.
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 497.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 498.
Can't use global @_ in "my" at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 524, near "= @_"
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 528.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 529.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 592, near "}"
/opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm has too many errors.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 13:47:57 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:03:15 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:03:15 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:21 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:22 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:23 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:25 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:05:38 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:05:39 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 14:15:29 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:15:30 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:35:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
[Tue Feb 17 14:40:41 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:46:29 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:55:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
Trotz des Fehlers wird der User angelegt, die Email jedoch nicht versand.
Das ist der Fehler des Apache - Error logs.
my "
Global symbol "$Sent" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 493.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 494.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 495.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 496.
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 497.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 498.
Can't use global @_ in "my" at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 524, near "= @_"
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 528.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 529.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 592, near "}"
/opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm has too many errors.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 13:47:55 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492, near ")
my "
Global symbol "$Sent" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 493.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 494.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 495.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 496.
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 497.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 498.
Can't use global @_ in "my" at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 524, near "= @_"
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 528.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 529.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 592, near "}"
/opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm has too many errors.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 13:47:57 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:03:15 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:03:15 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:21 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:22 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:23 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:25 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:05:38 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:05:39 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 14:15:29 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:15:30 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:35:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
[Tue Feb 17 14:40:41 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:46:29 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:55:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
Poste bitte mal den gesamten Code...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Code: Select all
# --
# Kernel/System/User.pm - some user functions
# Copyright (C) 2001-2014 xxx, http://otrs.com/
# --
# This software comes with ABSOLUTELY NO WARRANTY. For details, see
# the enclosed file COPYING for license information (AGPL). If you
# did not receive this file, see http://www.gnu.org/licenses/agpl.txt.
# --
package Kernel::System::User;
use strict;
use warnings;
use Crypt::PasswdMD5 qw(unix_md5_crypt);
use Digest::SHA;
use Kernel::System::CacheInternal;
use Kernel::System::CheckItem;
use Kernel::System::Email;
=head1 NAME
Kernel::System::User - user lib
=head1 SYNOPSIS
All user functions. E. g. to add and updated user and other functions.
=head1 PUBLIC INTERFACE
=over 4
=cut
=item new()
create an object
use Kernel::Config;
use Kernel::System::Encode;
use Kernel::System::Log;
use Kernel::System::Main;
use Kernel::System::Time;
use Kernel::System::DB;
use Kernel::System::User;
my $ConfigObject = Kernel::Config->new();
my $EncodeObject = Kernel::System::Encode->new(
ConfigObject => $ConfigObject,
);
my $LogObject = Kernel::System::Log->new(
ConfigObject => $ConfigObject,
EncodeObject => $EncodeObject,
);
my $MainObject = Kernel::System::Main->new(
ConfigObject => $ConfigObject,
EncodeObject => $EncodeObject,
LogObject => $LogObject,
);
my $TimeObject = Kernel::System::Time->new(
ConfigObject => $ConfigObject,
LogObject => $LogObject,
);
my $DBObject = Kernel::System::DB->new(
ConfigObject => $ConfigObject,
EncodeObject => $EncodeObject,
LogObject => $LogObject,
MainObject => $MainObject,
);
my $UserObject = Kernel::System::User->new(
ConfigObject => $ConfigObject,
LogObject => $LogObject,
MainObject => $MainObject,
TimeObject => $TimeObject,
DBObject => $DBObject,
EncodeObject => $EncodeObject,
);
=cut
sub new {
my ( $Type, %Param ) = @_;
# allocate new hash for object
my $Self = {};
bless( $Self, $Type );
# check needed objects
for (qw(DBObject ConfigObject LogObject TimeObject MainObject EncodeObject)) {
$Self->{$_} = $Param{$_} || die "Got no $_!";
}
# get user table
$Self->{UserTable} = $Self->{ConfigObject}->Get('DatabaseUserTable') || 'user';
$Self->{UserTableUserID} = $Self->{ConfigObject}->Get('DatabaseUserTableUserID') || 'id';
$Self->{UserTableUserPW} = $Self->{ConfigObject}->Get('DatabaseUserTableUserPW') || 'pw';
$Self->{UserTableUser} = $Self->{ConfigObject}->Get('DatabaseUserTableUser') || 'login';
# create needed object
$Self->{ValidObject} = Kernel::System::Valid->new( %{$Self} );
$Self->{CheckItemObject} = Kernel::System::CheckItem->new( %{$Self} );
$Self->{CacheInternalObject} = Kernel::System::CacheInternal->new(
%{$Self},
Type => 'User',
TTL => 60 * 60 * 3,
);
# set lower if database is case sensitive
$Self->{Lower} = '';
if ( $Self->{DBObject}->GetDatabaseFunction('CaseSensitive') ) {
$Self->{Lower} = 'LOWER';
}
# load generator preferences module
my $GeneratorModule = $Self->{ConfigObject}->Get('User::PreferencesModule')
|| 'Kernel::System::User::Preferences::DB';
if ( $Self->{MainObject}->Require($GeneratorModule) ) {
$Self->{PreferencesObject} = $GeneratorModule->new( %{$Self} );
}
return $Self;
}
=item GetUserData()
get user data (UserLogin, UserFirstname, UserLastname, UserEmail, ...)
my %User = $UserObject->GetUserData(
UserID => 123,
);
or
my %User = $UserObject->GetUserData(
User => 'franz',
Valid => 1, # not required -> 0|1 (default 0)
# returns only data if user is valid
NoOutOfOffice => 1, # not required -> 0|1 (default 0)
# returns data without out of office infos
);
=cut
sub GetUserData {
my ( $Self, %Param ) = @_;
# check needed stuff
if ( !$Param{User} && !$Param{UserID} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'Need User or UserID!' );
return;
}
# get configuration for the full name order
my $FirstnameLastNameOrder = $Self->{ConfigObject}->Get('FirstnameLastnameOrder') || 0;
# check if result is cached
if ( $Param{Valid} ) {
$Param{Valid} = 1;
}
else {
$Param{Valid} = 0;
}
if ( $Param{NoOutOfOffice} ) {
$Param{NoOutOfOffice} = 1;
}
else {
$Param{NoOutOfOffice} = 0;
}
my $CacheKey;
if ( $Param{User} ) {
$CacheKey
= 'GetUserData::User::'
. $Param{User} . '::'
. $Param{Valid} . '::'
. $FirstnameLastNameOrder . '::'
. $Param{NoOutOfOffice};
}
else {
$CacheKey
= 'GetUserData::UserID::'
. $Param{UserID} . '::'
. $Param{Valid} . '::'
. $FirstnameLastNameOrder . '::'
. $Param{NoOutOfOffice};
}
# check cache
my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
return %{$Cache} if $Cache;
# get initial data
my @Bind;
my $SQL = "SELECT $Self->{UserTableUserID}, $Self->{UserTableUser}, "
. " title, first_name, last_name, $Self->{UserTableUserPW}, valid_id, "
. " create_time, change_time FROM $Self->{UserTable} WHERE ";
if ( $Param{User} ) {
my $User = lc $Param{User};
$SQL .= " $Self->{Lower}($Self->{UserTableUser}) = ?";
push @Bind, \$User;
}
else {
$SQL .= " $Self->{UserTableUserID} = ?";
push @Bind, \$Param{UserID};
}
return if !$Self->{DBObject}->Prepare(
SQL => $SQL,
Bind => \@Bind,
Limit => 1,
);
my %Data;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
$Data{UserID} = $Row[0];
$Data{UserLogin} = $Row[1];
$Data{UserTitle} = $Row[2];
$Data{UserFirstname} = $Row[3];
$Data{UserLastname} = $Row[4];
$Data{UserPw} = $Row[5];
$Data{ValidID} = $Row[6];
$Data{CreateTime} = $Row[7];
$Data{ChangeTime} = $Row[8];
}
# check data
if ( !$Data{UserID} ) {
if ( $Param{User} ) {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Panic! No UserData for user: '$Param{User}'!!!",
);
return;
}
else {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Panic! No UserData for user id: '$Param{UserID}'!!!",
);
return;
}
}
# check valid, return if there is locked for valid users
if ( $Param{Valid} ) {
my $Hit = 0;
for ( $Self->{ValidObject}->ValidIDsGet() ) {
if ( $_ eq $Data{ValidID} ) {
$Hit = 1;
}
}
if ( !$Hit ) {
# set cache
$Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => {} );
return;
}
}
# generate the full name and save it in the hash
my $UserFullname;
if ( $FirstnameLastNameOrder eq '0' ) {
$UserFullname = $Data{UserFirstname} . ' '
. $Data{UserLastname};
}
elsif ( $FirstnameLastNameOrder eq '1' ) {
$UserFullname = $Data{UserLastname} . ', '
. $Data{UserFirstname};
}
elsif ( $FirstnameLastNameOrder eq '2' ) {
$UserFullname = $Data{UserFirstname} . ' '
. $Data{UserLastname} . ' ('
. $Data{UserLogin} . ')';
}
elsif ( $FirstnameLastNameOrder eq '3' ) {
$UserFullname = $Data{UserLastname} . ', '
. $Data{UserFirstname} . ' ('
. $Data{UserLogin} . ')';
}
elsif ( $FirstnameLastNameOrder eq '4' ) {
$UserFullname = '(' . $Data{UserLogin}
. ') ' . $Data{UserFirstname}
. ' ' . $Data{UserLastname};
}
elsif ( $FirstnameLastNameOrder eq '5' ) {
$UserFullname = '(' . $Data{UserLogin}
. ') ' . $Data{UserLastname}
. ', ' . $Data{UserFirstname};
}
# save the generated fullname in the hash.
$Data{UserFullname} = $UserFullname;
# get preferences
my %Preferences = $Self->GetPreferences( UserID => $Data{UserID} );
# add last login timestamp
if ( $Preferences{UserLastLogin} ) {
$Preferences{UserLastLoginTimestamp} = $Self->{TimeObject}->SystemTime2TimeStamp(
SystemTime => $Preferences{UserLastLogin},
);
}
# check compat stuff
if ( !$Preferences{UserEmail} ) {
$Preferences{UserEmail} = $Data{UserLogin};
}
# out of office check
if ( !$Param{NoOutOfOffice} ) {
if ( $Preferences{OutOfOffice} ) {
my $Time = $Self->{TimeObject}->SystemTime();
my $Start
= "$Preferences{OutOfOfficeStartYear}-$Preferences{OutOfOfficeStartMonth}-$Preferences{OutOfOfficeStartDay} 00:00:00";
my $TimeStart = $Self->{TimeObject}->TimeStamp2SystemTime(
String => $Start,
);
my $End
= "$Preferences{OutOfOfficeEndYear}-$Preferences{OutOfOfficeEndMonth}-$Preferences{OutOfOfficeEndDay} 23:59:59";
my $TimeEnd = $Self->{TimeObject}->TimeStamp2SystemTime(
String => $End,
);
my $Till = int( ( $TimeEnd - $Time ) / 60 / 60 / 24 );
my $TillDate
= "$Preferences{OutOfOfficeEndYear}-$Preferences{OutOfOfficeEndMonth}-$Preferences{OutOfOfficeEndDay}";
if ( $TimeStart < $Time && $TimeEnd > $Time ) {
$Preferences{OutOfOfficeMessage} = "*** out of office till $TillDate/$Till d ***";
$Data{UserLastname} .= ' ' . $Preferences{OutOfOfficeMessage};
}
}
}
# merge hash
%Data = ( %Data, %Preferences );
# add preferences defaults
my $Config = $Self->{ConfigObject}->Get('PreferencesGroups');
if ( $Config && ref $Config eq 'HASH' ) {
for my $Key ( sort keys %{$Config} ) {
# next if no default data exists
next if !defined $Config->{$Key}->{DataSelected};
# check if data is defined
next if defined $Data{ $Config->{$Key}->{PrefKey} };
# set default data
$Data{ $Config->{$Key}->{PrefKey} } = $Config->{$Key}->{DataSelected};
}
}
# set cache
$Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => \%Data );
return %Data;
}
=item UserAdd()
to add new users
my $UserID = $UserObject->UserAdd(
UserFirstname => 'Huber',
UserLastname => 'Manfred',
UserLogin => 'mhuber',
UserPw => 'some-pass', # not required
UserEmail => 'email@example.com',
ValidID => 1,
ChangeUserID => 123,
);
=cut
sub UserAdd {
my ( $Self, %Param ) = @_;
# check needed stuff
for (qw(UserFirstname UserLastname UserLogin UserEmail ValidID ChangeUserID)) {
if ( !$Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
# check if a user with this login (username) already exits
if ( $Self->UserLoginExistsCheck( UserLogin => $Param{UserLogin} ) ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => "A user with username '$Param{UserLogin}' already exists!"
);
return;
}
# check email address
if (
$Param{UserEmail}
&& !$Self->{CheckItemObject}->CheckEmail( Address => $Param{UserEmail} )
)
{
$Self->{LogObject}->Log(
Priority => 'error',
Message => "Email address ($Param{UserEmail}) not valid ("
. $Self->{CheckItemObject}->CheckError() . ")!",
);
return;
}
# check password
if ( !$Param{UserPw} ) {
$Param{UserPw} = $Self->GenerateRandomPassword();
}
# sql
return if !$Self->{DBObject}->Do(
SQL => "INSERT INTO $Self->{UserTable} "
. "(title, first_name, last_name, "
. " $Self->{UserTableUser}, $Self->{UserTableUserPW}, "
. " valid_id, create_time, create_by, change_time, change_by)"
. " VALUES "
. " (?, ?, ?, ?, ?, ?, current_timestamp, ?, current_timestamp, ?)",
Bind => [
\$Param{UserTitle}, \$Param{UserFirstname}, \$Param{UserLastname},
\$Param{UserLogin}, \$Param{UserPw}, \$Param{ValidID},
\$Param{ChangeUserID}, \$Param{ChangeUserID},
],
);
# get new user id
my $UserLogin = lc $Param{UserLogin};
return if !$Self->{DBObject}->Prepare(
SQL => "SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} "
. " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
Bind => [ \$UserLogin ],
Limit => 1,
);
# fetch the result
my $UserID;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
$UserID = $Row[0];
}
# check if user exists
if ( !$UserID ) {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Unable to create User: '$Param{UserLogin}' ($Param{ChangeUserID})!",
);
return;
}
# log notice
$Self->{LogObject}->Log(
Priority => 'notice',
Message =>
"User: '$Param{UserLogin}' ID: '$UserID' created successfully ($Param{ChangeUserID})!",
);
# set password
$Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );
# set email address
$Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );
# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
#send email
my $ContentType = 'text/plain';
my $Sent = $Self->{SendmailObject}->Send(
From => $Self->{ConfigObject}->Get('NotificationSenderEmail'),
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
);
return $UserID;
}
=item UserUpdate()
to update users
$UserObject->UserUpdate(
UserID => 4321,
UserFirstname => 'Huber',
UserLastname => 'Manfred',
UserLogin => 'mhuber',
UserPw => 'some-pass', # not required
UserEmail => 'email@example.com',
ValidID => 1,
ChangeUserID => 123,
);
=cut
sub UserUpdate {
my ( $Self, %Param ) = @_;
# check needed stuff
for (qw(UserID UserFirstname UserLastname UserLogin ValidID ChangeUserID)) {
if ( !$Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
# check if a user with this login (username) already exits
if ( $Self->UserLoginExistsCheck( UserLogin => $Param{UserLogin}, UserID => $Param{UserID} ) ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => "A user with username '$Param{UserLogin}' already exists!"
);
return;
}
# check email address
if (
$Param{UserEmail}
&& !$Self->{CheckItemObject}->CheckEmail( Address => $Param{UserEmail} )
)
{
$Self->{LogObject}->Log(
Priority => 'error',
Message => "Email address ($Param{UserEmail}) not valid ("
. $Self->{CheckItemObject}->CheckError() . ")!",
);
return;
}
# update db
return if !$Self->{DBObject}->Do(
SQL => "UPDATE $Self->{UserTable} SET title = ?, first_name = ?, last_name = ?, "
. " $Self->{UserTableUser} = ?, valid_id = ?, "
. " change_time = current_timestamp, change_by = ? "
. " WHERE $Self->{UserTableUserID} = ?",
Bind => [
\$Param{UserTitle}, \$Param{UserFirstname}, \$Param{UserLastname},
\$Param{UserLogin}, \$Param{ValidID}, \$Param{ChangeUserID}, \$Param{UserID},
],
);
# log notice
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "User: '$Param{UserLogin}' updated successfully ($Param{ChangeUserID})!",
);
# check pw
if ( $Param{UserPw} ) {
$Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );
}
# set email address
$Self->SetPreferences(
UserID => $Param{UserID},
Key => 'UserEmail',
Value => $Param{UserEmail}
);
# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
return 1;
}
=item UserSearch()
to search users
my %List = $UserObject->UserSearch(
Search => '*some*', # also 'hans+huber' possible
Valid => 1, # not required
);
my %List = $UserObject->UserSearch(
UserLogin => '*some*',
Limit => 50,
Valid => 1, # not required
);
my %List = $UserObject->UserSearch(
PostMasterSearch => 'email@example.com',
Valid => 1, # not required
);
=cut
sub UserSearch {
my ( $Self, %Param ) = @_;
my %Users;
my $Valid = defined $Param{Valid} ? $Param{Valid} : 1;
# check needed stuff
if ( !$Param{Search} && !$Param{UserLogin} && !$Param{PostMasterSearch} ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => 'Need Search, UserLogin or PostMasterSearch!',
);
return;
}
# get like escape string needed for some databases (e.g. oracle)
my $LikeEscapeString = $Self->{DBObject}->GetDatabaseFunction('LikeEscapeString');
# build SQL string 1/2
my $SQL = "SELECT $Self->{UserTableUserID} ";
my @Fields = qw(login first_name last_name);
if (@Fields) {
for my $Entry (@Fields) {
$SQL .= ", $Entry";
}
}
# build SQL string 2/2
$SQL .= " FROM $Self->{UserTable} WHERE ";
if ( $Param{Search} ) {
$SQL .= $Self->{DBObject}->QueryCondition(
Key => \@Fields,
Value => $Param{Search},
) . ' ';
}
elsif ( $Param{PostMasterSearch} ) {
my %UserID = $Self->SearchPreferences(
Key => 'UserEmail',
Value => $Param{PostMasterSearch},
);
for ( sort keys %UserID ) {
my %User = $Self->GetUserData(
UserID => $_,
Valid => $Param{Valid},
);
if (%User) {
return %UserID;
}
}
return;
}
elsif ( $Param{UserLogin} ) {
$Param{UserLogin} =~ s/\*/%/g;
$SQL .= " $Self->{Lower}($Self->{UserTableUser}) LIKE $Self->{Lower}('"
. $Self->{DBObject}->Quote( $Param{UserLogin}, 'Like' ) . "') $LikeEscapeString";
}
# add valid option
if ($Valid) {
$SQL .= "AND valid_id IN (" . join( ', ', $Self->{ValidObject}->ValidIDsGet() ) . ")";
}
# get data
return if !$Self->{DBObject}->Prepare(
SQL => $SQL,
Limit => $Self->{UserSearchListLimit} || $Param{Limit},
);
# fetch the result
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
for ( 1 .. 8 ) {
if ( $Row[$_] ) {
$Users{ $Row[0] } .= $Row[$_] . ' ';
}
}
$Users{ $Row[0] } =~ s/^(.*)\s(.+?\@.+?\..+?)(\s|)$/"$1" <$2>/;
}
return %Users;
}
=item SetPassword()
to set users passwords
$UserObject->SetPassword(
UserLogin => 'some-login',
PW => 'some-new-password'
);
=cut
sub SetPassword {
my ( $Self, %Param ) = @_;
# check needed stuff
if ( !$Param{UserLogin} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'Need UserLogin!' );
return;
}
# get old user data
my %User = $Self->GetUserData( User => $Param{UserLogin} );
if ( !$User{UserLogin} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'No such User!' );
return;
}
my $Pw = $Param{PW} || '';
my $CryptedPw = '';
# get crypt type
my $CryptType = $Self->{ConfigObject}->Get('AuthModule::DB::CryptType') || 'sha2';
# crypt plain (no crypt at all)
if ( $CryptType eq 'plain' ) {
$CryptedPw = $Pw;
}
# crypt with unix crypt
elsif ( $CryptType eq 'crypt' ) {
# encode output, needed by crypt() only non utf8 signs
$Self->{EncodeObject}->EncodeOutput( \$Pw );
$Self->{EncodeObject}->EncodeOutput( \$Param{UserLogin} );
$CryptedPw = crypt( $Pw, $Param{UserLogin} );
}
# crypt with md5
elsif ( $CryptType eq 'md5' || !$CryptType ) {
# encode output, needed by unix_md5_crypt() only non utf8 signs
$Self->{EncodeObject}->EncodeOutput( \$Pw );
$Self->{EncodeObject}->EncodeOutput( \$Param{UserLogin} );
$CryptedPw = unix_md5_crypt( $Pw, $Param{UserLogin} );
}
# crypt with sha1
elsif ( $CryptType eq 'sha1' ) {
my $SHAObject = Digest::SHA->new('sha1');
# encode output, needed by sha1_hex() only non utf8 signs
$Self->{EncodeObject}->EncodeOutput( \$Pw );
$SHAObject->add($Pw);
$CryptedPw = $SHAObject->hexdigest();
}
# bcrypt
elsif ( $CryptType eq 'bcrypt' ) {
if ( !$Self->{MainObject}->Require('Crypt::Eksblowfish::Bcrypt') ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message =>
"User: '$User{UserLogin}' tried to store password with bcrypt but 'Crypt::Eksblowfish::Bcrypt' is not installed!",
);
return;
}
my $Cost = 9;
my $Salt = $Self->{MainObject}->GenerateRandomString( Length => 16 );
# remove UTF8 flag, required by Crypt::Eksblowfish::Bcrypt
$Self->{EncodeObject}->EncodeOutput( \$Pw );
# calculate password hash
my $Octets = Crypt::Eksblowfish::Bcrypt::bcrypt_hash(
{
key_nul => 1,
cost => 9,
salt => $Salt,
},
$Pw
);
# We will store cost and salt in the password string so that it can be decoded
# in future even if we use a higher cost by default.
$CryptedPw = "BCRYPT:$Cost:$Salt:" . Crypt::Eksblowfish::Bcrypt::en_base64($Octets);
}
# crypt with sha256 as fallback
else {
my $SHAObject = Digest::SHA->new('sha256');
# encode output, needed by sha256_hex() only non utf8 signs
$Self->{EncodeObject}->EncodeOutput( \$Pw );
$SHAObject->add($Pw);
$CryptedPw = $SHAObject->hexdigest();
}
# update db
my $UserLogin = lc $Param{UserLogin};
return if !$Self->{DBObject}->Do(
SQL => "UPDATE $Self->{UserTable} SET $Self->{UserTableUserPW} = ? "
. " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
Bind => [ \$CryptedPw, \$UserLogin ],
);
# log notice
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "User: '$Param{UserLogin}' changed password successfully!",
);
return 1;
}
=item UserLookup()
user login or id lookup
my $UserLogin = $UserObject->UserLookup(
UserID => 1,
);
my $UserID = $UserObject->UserLookup(
UserLogin => 'some_user_login',
);
=cut
sub UserLookup {
my ( $Self, %Param ) = @_;
# check needed stuff
if ( !$Param{UserLogin} && !$Param{UserID} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'Need UserLogin or UserID!' );
return;
}
if ( $Param{UserLogin} ) {
# check cache
my $CacheKey = 'UserLookup::ID::' . $Param{UserLogin};
my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
return $Cache if $Cache;
# build sql query
my $UserLogin = lc $Param{UserLogin};
return if !$Self->{DBObject}->Prepare(
SQL => "SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} "
. " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
Bind => [ \$UserLogin ],
Limit => 1,
);
# fetch the result
my $ID;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
$ID = $Row[0];
}
if ( !$ID ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => "No UserID found for '$Param{UserLogin}'!",
);
return;
}
# set cache
$Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => $ID );
return $ID;
}
else {
# check cache
my $CacheKey = 'UserLookup::Login::' . $Param{UserID};
my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
return $Cache if $Cache;
# build sql query
return if !$Self->{DBObject}->Prepare(
SQL => "SELECT $Self->{UserTableUser} FROM $Self->{UserTable} "
. " WHERE $Self->{UserTableUserID} = ?",
Bind => [ \$Param{UserID} ],
Limit => 1,
);
# fetch the result
my $Login;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
$Login = $Row[0];
}
if ( !$Login ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => "No UserLogin found for '$Param{UserID}'!",
);
return;
}
# set cache
$Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => $Login );
return $Login;
}
}
=item UserName()
get user name
my $Name = $UserObject->UserName(
UserLogin => 'some-login',
);
or
my $Name = $UserObject->UserName(
UserID => 123,
);
=cut
sub UserName {
my ( $Self, %Param ) = @_;
my %User = $Self->GetUserData(%Param);
return if !%User;
return $User{UserFullname};
}
=item UserList()
return a hash with all users
my %List = $UserObject->UserList(
Type => 'Short', # Short|Long, default Short
Valid => 1, # not required, default 0
);
=cut
sub UserList {
my ( $Self, %Param ) = @_;
my $Type = $Param{Type} || 'Short';
# set valid option
my $Valid = $Param{Valid};
if ( !defined $Valid || $Valid ) {
$Valid = 1;
}
else {
$Valid = 0;
}
# get configuration for the full name order
my $FirstnameLastNameOrder = $Self->{ConfigObject}->Get('FirstnameLastnameOrder') || 0;
# check cache
my $CacheKey = 'UserList::' . $Type . '::' . $Valid
. '::' . $FirstnameLastNameOrder;
my $Cache = $Self->{CacheInternalObject}->Get(
Key => $CacheKey,
);
return %{$Cache} if $Cache;
my $SelectStr;
if ( $Type eq 'Short' ) {
$SelectStr = "$Self->{ConfigObject}->{DatabaseUserTableUserID}, "
. " $Self->{ConfigObject}->{DatabaseUserTableUser}";
}
else {
$SelectStr = "$Self->{ConfigObject}->{DatabaseUserTableUserID}, "
. " last_name, first_name, "
. " $Self->{ConfigObject}->{DatabaseUserTableUser}";
}
# sql query
if ($Valid) {
return if !$Self->{DBObject}->Prepare(
SQL =>
"SELECT $SelectStr FROM $Self->{ConfigObject}->{DatabaseUserTable} WHERE valid_id IN "
. "( ${\(join ', ', $Self->{ValidObject}->ValidIDsGet())} )",
);
}
else {
return if !$Self->{DBObject}->Prepare(
SQL => "SELECT $SelectStr FROM $Self->{ConfigObject}->{DatabaseUserTable}",
);
}
# fetch the result
my %UsersRaw;
my %Users;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
$UsersRaw{ $Row[0] } = $Row[1];
}
if ( $Type eq 'Short' ) {
%Users = %UsersRaw;
}
else {
for my $CurrentUserID ( sort keys %UsersRaw ) {
my $UserFullname = $Self->UserName( UserID => $CurrentUserID );
$Users{$CurrentUserID} = $UserFullname;
}
}
# check vacation option
for my $UserID ( sort keys %Users ) {
next if !$UserID;
my %User = $Self->GetUserData(
UserID => $UserID,
);
if ( $User{OutOfOfficeMessage} ) {
$Users{$UserID} .= ' ' . $User{OutOfOfficeMessage};
}
}
# set cache
$Self->{CacheInternalObject}->Set(
Key => $CacheKey,
Value => \%Users,
);
return %Users;
}
=item GenerateRandomPassword()
generate a random password
my $Password = $UserObject->GenerateRandomPassword();
or
my $Password = $UserObject->GenerateRandomPassword(
Size => 16,
);
=cut
sub GenerateRandomPassword {
my ( $Self, %Param ) = @_;
# Generated passwords are eight characters long by default.
my $Size = $Param{Size} || 8;
my $Password = $Self->{MainObject}->GenerateRandomString(
Length => $Size,
);
# Return the password.
return $Password;
}
=item SetPreferences()
set user preferences
$UserObject->SetPreferences(
Key => 'UserComment',
Value => 'some comment',
UserID => 123,
);
=cut
sub SetPreferences {
my ( $Self, %Param ) = @_;
# check needed stuff
for (qw(Key UserID)) {
if ( !$Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
# get current setting
my %User = $Self->GetUserData(
UserID => $Param{UserID},
NoOutOfOffice => 1,
);
# no updated needed
return 1
if defined $User{ $Param{Key} }
&& defined $Param{Value}
&& $User{ $Param{Key} } eq $Param{Value};
# delete cache
my $Login = $Self->UserLookup( UserID => $Param{UserID} );
$Self->{CacheInternalObject}->CleanUp();
# set preferences
return $Self->{PreferencesObject}->SetPreferences(%Param);
}
=item GetPreferences()
get user preferences
my %Preferences = $UserObject->GetPreferences(
UserID => 123,
);
=cut
sub GetPreferences {
my ( $Self, %Param ) = @_;
return $Self->{PreferencesObject}->GetPreferences(%Param);
}
=item SearchPreferences()
search in user preferences
my %UserList = $UserObject->SearchPreferences(
Key => 'UserEmail',
Value => 'email@example.com', # optional, limit to a certain value/pattern
);
=cut
sub SearchPreferences {
my $Self = shift;
return $Self->{PreferencesObject}->SearchPreferences(@_);
}
=item TokenGenerate()
generate a random token
my $Token = $UserObject->TokenGenerate(
UserID => 123,
);
=cut
sub TokenGenerate {
my ( $Self, %Param ) = @_;
# check needed stuff
if ( !$Param{UserID} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need UserID!" );
return;
}
my $Token = $Self->{MainObject}->GenerateRandomString(
Length => 15,
);
# save token in preferences
$Self->SetPreferences(
Key => 'UserToken',
Value => $Token,
UserID => $Param{UserID},
);
return $Token;
}
=item TokenCheck()
check password token
my $Valid = $UserObject->TokenCheck(
Token => $Token,
UserID => 123,
);
=cut
sub TokenCheck {
my ( $Self, %Param ) = @_;
# check needed stuff
if ( !$Param{Token} || !$Param{UserID} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'Need Token and UserID!' );
return;
}
# get preferences token
my %Preferences = $Self->GetPreferences(
UserID => $Param{UserID},
);
# check requested vs. stored token
if ( $Preferences{UserToken} && $Preferences{UserToken} eq $Param{Token} ) {
# reset password token
$Self->SetPreferences(
Key => 'UserToken',
Value => '',
UserID => $Param{UserID},
);
# return true if token is valid
return 1;
}
# return false if token is invalid
return;
}
=item UserLoginExistsCheck()
return 1 if another user with this login (username) already exits
$Exist = $UserObject->UserLoginExistsCheck(
UserLogin => 'Some::UserLogin',
UserID => 1, # optional
);
=cut
sub UserLoginExistsCheck {
my ( $Self, %Param ) = @_;
return if !$Self->{DBObject}->Prepare(
SQL =>
"SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} WHERE $Self->{UserTableUser} = ?",
Bind => [ \$Param{UserLogin} ],
);
# fetch the result
my $Flag;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
if ( !$Param{UserID} || $Param{UserID} ne $Row[0] ) {
$Flag = 1;
}
}
if ($Flag) {
return 1;
}
return 0;
}
1;
=back
=head1 TERMS AND CONDITIONS
This software is part of the OTRS project (L<http://otrs.org/>).
This software comes with ABSOLUTELY NO WARRANTY. For details, see
the enclosed file COPYING for license information (AGPL). If you
did not receive this file, see L<http://www.gnu.org/licenses/agpl.txt>.
=cut
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
In der sub new musst Du noch ein machen. Ansonsten sind keine Syntaxfehler drin. Starte dann mal den Apachen neu...
Code: Select all
$Self->{SendmailObject} = Kernel::System::Email->new(%{$Self});
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Danke für die Antwort. 
Jetzt habe ich den Bereich new durch deinen Code erweiterert.
Die Fehlemeldung tritt nun nichtmehr auf, beim übermitteln der Daten, jedoch wird trotzdem keine Email an die jeweilige Mail versendet.
Den Apache Server habe ich schon neugestartet.
Im Apache Error ist jedoch eine neue Fehlermeldung aufgetreten.
my "
Global symbol "$Sent" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 493.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 494.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 495.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 496.
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 497.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 498.
Can't use global @_ in "my" at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 524, near "= @_"
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 528.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 529.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 592, near "}"
/opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm has too many errors.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 13:47:57 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:03:15 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:03:15 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:21 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:22 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:23 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:25 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:05:38 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:05:39 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 14:15:29 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:15:30 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:35:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
[Tue Feb 17 14:40:41 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:46:29 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:55:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
[Tue Feb 17 15:57:05 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 15:57:06 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
ERROR: OTRS-CGI-40 Perl: 5.14.2 OS: linux Time: Tue Feb 17 15:58:44 2015
Message: Need Charset!
RemoteAddress: 10.176.6.119
RequestURI: /otrs/index.pl
Traceback (4887):
Module: Kernel::System::Email::Send (OTRS 3.3.10) Line: 176
Module: Kernel::System::User::UserAdd (OTRS 3.3.10) Line: 482
Module: Kernel::Modules::AdminUser::Run (OTRS 3.3.10) Line: 363
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 871
Module: /opt/otrs/bin/cgi-bin/index.pl (unknown version) Line: 49
[Tue Feb 17 15:59:26 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 15:59:27 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
ERROR: OTRS-CGI-40 Perl: 5.14.2 OS: linux Time: Tue Feb 17 16:02:25 2015
Message: Need Charset!
RemoteAddress: 10.176.6.119
RequestURI: /otrs/index.pl
Traceback (5049):
Module: Kernel::System::Email::Send (OTRS 3.3.10) Line: 176
Module: Kernel::System::User::UserAdd (OTRS 3.3.10) Line: 482
Module: Kernel::Modules::AdminUser::Run (OTRS 3.3.10) Line: 363
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 871
Module: /opt/otrs/bin/cgi-bin/index.pl (unknown version) Line: 49
Eine Idee was ich noch versuchen könnte?

Jetzt habe ich den Bereich new durch deinen Code erweiterert.
Code: Select all
sub new {
my ( $Type, %Param ) = @_;
# allocate new hash for object
my $Self = {};
bless( $Self, $Type );
# check needed objects
for (qw(DBObject ConfigObject LogObject TimeObject MainObject EncodeObject)) {
$Self->{$_} = $Param{$_} || die "Got no $_!";
}
$Self->{SendmailObject} = Kernel::System::Email->new(%{$Self});
# get user table
$Self->{UserTable} = $Self->{ConfigObject}->Get('DatabaseUserTable') || 'user';
$Self->{UserTableUserID} = $Self->{ConfigObject}->Get('DatabaseUserTableUserID') || 'id';
$Self->{UserTableUserPW} = $Self->{ConfigObject}->Get('DatabaseUserTableUserPW') || 'pw';
$Self->{UserTableUser} = $Self->{ConfigObject}->Get('DatabaseUserTableUser') || 'login';
# create needed object
$Self->{ValidObject} = Kernel::System::Valid->new( %{$Self} );
$Self->{CheckItemObject} = Kernel::System::CheckItem->new( %{$Self} );
$Self->{CacheInternalObject} = Kernel::System::CacheInternal->new(
%{$Self},
Type => 'User',
TTL => 60 * 60 * 3,
);
# set lower if database is case sensitive
$Self->{Lower} = '';
if ( $Self->{DBObject}->GetDatabaseFunction('CaseSensitive') ) {
$Self->{Lower} = 'LOWER';
}
# load generator preferences module
my $GeneratorModule = $Self->{ConfigObject}->Get('User::PreferencesModule')
|| 'Kernel::System::User::Preferences::DB';
if ( $Self->{MainObject}->Require($GeneratorModule) ) {
$Self->{PreferencesObject} = $GeneratorModule->new( %{$Self} );
}
return $Self;
}
Die Fehlemeldung tritt nun nichtmehr auf, beim übermitteln der Daten, jedoch wird trotzdem keine Email an die jeweilige Mail versendet.
Den Apache Server habe ich schon neugestartet.
Im Apache Error ist jedoch eine neue Fehlermeldung aufgetreten.
my "
Global symbol "$Sent" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 492.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 493.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 494.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 495.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 496.
Global symbol "$ContentType" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 497.
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 498.
Can't use global @_ in "my" at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 524, near "= @_"
Global symbol "%Param" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 528.
Global symbol "$Self" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 529.
syntax error at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 592, near "}"
/opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm has too many errors.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 13:47:57 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:03:15 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:03:15 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:21 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:22 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:23 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
Global symbol "$SendObject" requires explicit package name at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 483.
Compilation failed in require at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/../../Kernel/System/Web/InterfaceAgent.pm line 24.
Compilation failed in require at /opt/otrs/bin/cgi-bin/index.pl line 43.
BEGIN failed--compilation aborted at /opt/otrs/bin/cgi-bin/index.pl line 43.
[Tue Feb 17 14:03:25 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl
[Tue Feb 17 14:05:38 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:05:39 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 14:15:29 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:15:30 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:35:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
[Tue Feb 17 14:40:41 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:46:29 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
Can't call method "Send" on an undefined value at /opt/otrs/bin/cgi-bin/../../Kernel/System/User.pm line 482.
[Tue Feb 17 14:55:13 2015] [error] [client 10.176.6.119] Premature end of script headers: index.pl, referer: http://172.26.41.93/otrs/index.pl?Actio ... action=Add
[Tue Feb 17 15:57:05 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 15:57:06 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
ERROR: OTRS-CGI-40 Perl: 5.14.2 OS: linux Time: Tue Feb 17 15:58:44 2015
Message: Need Charset!
RemoteAddress: 10.176.6.119
RequestURI: /otrs/index.pl
Traceback (4887):
Module: Kernel::System::Email::Send (OTRS 3.3.10) Line: 176
Module: Kernel::System::User::UserAdd (OTRS 3.3.10) Line: 482
Module: Kernel::Modules::AdminUser::Run (OTRS 3.3.10) Line: 363
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 871
Module: /opt/otrs/bin/cgi-bin/index.pl (unknown version) Line: 49
[Tue Feb 17 15:59:26 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 15:59:27 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
ERROR: OTRS-CGI-40 Perl: 5.14.2 OS: linux Time: Tue Feb 17 16:02:25 2015
Message: Need Charset!
RemoteAddress: 10.176.6.119
RequestURI: /otrs/index.pl
Traceback (5049):
Module: Kernel::System::Email::Send (OTRS 3.3.10) Line: 176
Module: Kernel::System::User::UserAdd (OTRS 3.3.10) Line: 482
Module: Kernel::Modules::AdminUser::Run (OTRS 3.3.10) Line: 363
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 871
Module: /opt/otrs/bin/cgi-bin/index.pl (unknown version) Line: 49
Eine Idee was ich noch versuchen könnte?
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
In dem Code, den Du in Deinem vorigen Post gezeigt hast, gibt es kein $SendObject und ein Syntaxfehler war auch nicht drin. Der Apache lädt anscheinend irgendeine andere Datei...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Code: Select all
my $ContentType = 'text/plain';
my $Sent = $Self->{SendmailObject}->Send(
From => $Self->{ConfigObject}->Get('NotificationSenderEmail'),
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => $Self->{LayoutObject}->{UserCharset},
MimeType => $ContentType,
Body => 'Name und PW',
);
return $UserID;
Code: Select all
my $Sent = $SendObject->Send(
From => 'me@example.com',
To => 'friend@example.com',
Cc => 'Some Customer B <customer-b@example.com>', # not required
ReplyTo => 'Some Customer B <customer-b@example.com>', # not required, is possible to use 'Reply-To' instead
Subject => 'Some words!',);
Macht es einen Unterschied, dass in Email.pm "my $Sent = $SendObject->Send(); "hinter legt ist und in User.pm "my $Sent = $Self->{SendmailObject}->Send();"
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
Hast Du in Email.pm auch was geändert? Das mit den "$SendObject" sollte eigentlich nur in der Dokumentation (zwischen =item ... und =cut) stehen...
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Nein in Email.pm wurde nichts geändert.
Code: Select all
# --
# Kernel/System/Email.pm - the global email send module
# Copyright (C) 2001-2014 xxx, http://otrs.com/
# --
# This software comes with ABSOLUTELY NO WARRANTY. For details, see
# the enclosed file COPYING for license information (AGPL). If you
# did not receive this file, see http://www.gnu.org/licenses/agpl.txt.
# --
package Kernel::System::Email;
## nofilter(TidyAll::Plugin::OTRS::Perl::Require)
use strict;
use warnings;
use MIME::Entity;
use Mail::Address;
use Kernel::System::Crypt;
use Kernel::System::HTMLUtils;
use Kernel::System::VariableCheck qw(:all);
=head1 NAME
Kernel::System::Email - to send email
=head1 SYNOPSIS
Global module to send email via sendmail or SMTP.
=head1 PUBLIC INTERFACE
=over 4
=cut
=item new()
create an object
use Kernel::Config;
use Kernel::System::Encode;
use Kernel::System::Log;
use Kernel::System::Main;
use Kernel::System::Time;
use Kernel::System::DB;
use Kernel::System::Email;
my $ConfigObject = Kernel::Config->new();
my $EncodeObject = Kernel::System::Encode->new(
ConfigObject => $ConfigObject,
);
my $LogObject = Kernel::System::Log->new(
ConfigObject => $ConfigObject,
EncodeObject => $EncodeObject,
);
my $MainObject = Kernel::System::Main->new(
ConfigObject => $ConfigObject,
EncodeObject => $EncodeObject,
LogObject => $LogObject,
);
my $TimeObject = Kernel::System::Time->new(
ConfigObject => $ConfigObject,
LogObject => $LogObject,
);
my $DBObject = Kernel::System::DB->new(
ConfigObject => $ConfigObject,
EncodeObject => $EncodeObject,
LogObject => $LogObject,
MainObject => $MainObject,
);
my $SendObject = Kernel::System::Email->new(
ConfigObject => $ConfigObject,
LogObject => $LogObject,
DBObject => $DBObject,
MainObject => $MainObject,
TimeObject => $TimeObject,
EncodeObject => $EncodeObject,
);
=cut
sub new {
my ( $Type, %Param ) = @_;
# allocate new hash for object
my $Self = {%Param};
bless( $Self, $Type );
# debug level
$Self->{Debug} = $Param{Debug} || 0;
# check all needed objects
for (qw(ConfigObject LogObject DBObject TimeObject MainObject EncodeObject)) {
die "Got no $_" if !$Self->{$_};
}
# load generator backend module
my $GenericModule = $Self->{ConfigObject}->Get('SendmailModule')
|| 'Kernel::System::Email::Sendmail';
return if !$Self->{MainObject}->Require($GenericModule);
# create backend object
$Self->{Backend} = $GenericModule->new( %{$Self} );
$Self->{HTMLUtilsObject} = Kernel::System::HTMLUtils->new( %{$Self} );
return $Self;
}
=item Send()
To send an email without already created header:
my $Sent = $SendObject->Send(
From => 'me@example.com',
To => 'friend@example.com',
Cc => 'Some Customer B <customer-b@example.com>', # not required
ReplyTo => 'Some Customer B <customer-b@example.com>', # not required, is possible to use 'Reply-To' instead
Subject => 'Some words!',
Charset => 'iso-8859-15',
MimeType => 'text/plain', # "text/plain" or "text/html"
Body => 'Some nice text',
InReplyTo => '<somemessageid-2@example.com>',
References => '<somemessageid-1@example.com> <somemessageid-2@example.com>',
Loop => 1, # not required, removes smtp from
CustomHeaders => {
X-OTRS-MyHeader => 'Some Value',
},
Attachment => [
{
Filename => "somefile.csv",
Content => $ContentCSV,
ContentType => "text/csv",
},
{
Filename => "somefile.png",
Content => $ContentPNG,
ContentType => "image/png",
}
],
Sign => {
Type => 'PGP',
SubType => 'Inline|Detached',
Key => '81877F5E',
Type => 'SMIME',
Key => '3b630c80',
},
Crypt => {
Type => 'PGP',
SubType => 'Inline|Detached',
Key => '81877F5E',
Type => 'SMIME',
Key => '3b630c80',
},
);
if ($Sent) {
print "Email sent!\n";
}
else {
print "Email not sent!\n";
}
=cut
sub Send {
my ( $Self, %Param ) = @_;
# check needed stuff
for (qw(Body Charset)) {
if ( !$Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
if ( !$Param{To} && !$Param{Cc} && !$Param{Bcc} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'Need To, Cc or Bcc!' );
return;
}
# check from
if ( !$Param{From} ) {
$Param{From} = $Self->{ConfigObject}->Get('AdminEmail') || 'otrs@localhost';
}
# replace all br tags with br tags with a space to show newlines in Lotus Notes
if ( $Param{MimeType} && lc $Param{MimeType} eq 'text/html' ) {
$Param{Body} =~ s{\Q<br/>\E}{<br />}xmsgi;
}
# map ReplyTo into Reply-To if present
if ( $Param{ReplyTo} ) {
$Param{'Reply-To'} = $Param{ReplyTo};
}
# get sign options for inline
if ( $Param{Sign} && $Param{Sign}->{SubType} && $Param{Sign}->{SubType} eq 'Inline' ) {
my $CryptObject = Kernel::System::Crypt->new(
LogObject => $Self->{LogObject},
DBObject => $Self->{DBObject},
ConfigObject => $Self->{ConfigObject},
EncodeObject => $Self->{EncodeObject},
CryptType => $Param{Sign}->{Type},
MainObject => $Self->{MainObject},
);
if ( !$CryptObject ) {
return;
}
my $Body = $CryptObject->Sign(
Message => $Param{Body},
Key => $Param{Sign}->{Key},
Type => 'Clearsign',
Charset => $Param{Charset},
);
if ($Body) {
$Param{Body} = $Body;
}
}
# crypt inline
if ( $Param{Crypt} && $Param{Crypt}->{Type} eq 'PGP' && $Param{Crypt}->{SubType} eq 'Inline' ) {
my $CryptObject = Kernel::System::Crypt->new(
LogObject => $Self->{LogObject},
DBObject => $Self->{DBObject},
ConfigObject => $Self->{ConfigObject},
EncodeObject => $Self->{EncodeObject},
CryptType => $Param{Crypt}->{Type},
MainObject => $Self->{MainObject},
);
if ( !$CryptObject ) {
$Self->{LogObject}->Log(
Message => 'Not possible to create crypt object',
Priority => 'error',
);
return;
}
my $Body = $CryptObject->Crypt(
Message => $Param{Body},
Key => $Param{Crypt}->{Key},
Type => $Param{Crypt}->{SubType},
);
if ($Body) {
$Param{Body} = $Body;
}
}
# build header
my %Header;
if ( IsHashRefWithData( $Param{CustomHeaders} ) ) {
%Header = %{ $Param{CustomHeaders} };
}
for (qw(From To Cc Subject Charset Reply-To)) {
next if !$Param{$_};
$Header{$_} = $Param{$_};
}
# loop
if ( $Param{Loop} ) {
$Header{'X-Loop'} = 'yes';
$Header{'Precedence:'} = 'bulk';
$Header{'Auto-Submitted:'} = "auto-generated";
}
# do some encode
for (qw(From To Cc Subject)) {
next if !$Header{$_};
$Header{$_} = $Self->_EncodeMIMEWords(
Field => $_,
Line => $Header{$_},
Charset => $Param{Charset},
);
}
# check if it's html, add text attachment
my $HTMLEmail = 0;
if ( $Param{MimeType} && $Param{MimeType} =~ /html/i ) {
$HTMLEmail = 1;
# add html as first attachment
my $Attach = {
Content => $Param{Body},
ContentType => "text/html; charset=\"$Param{Charset}\"",
Filename => '',
};
if ( !$Param{Attachment} ) {
@{ $Param{Attachment} } = ($Attach);
}
else {
@{ $Param{Attachment} } = ( $Attach, @{ $Param{Attachment} } );
}
# remember html body for later comparison
$Param{HTMLBody} = $Param{Body};
# add ascii body
$Param{MimeType} = 'text/plain';
$Param{Body} = $Self->{HTMLUtilsObject}->ToAscii(
String => $Param{Body},
);
}
my $Product = $Self->{ConfigObject}->Get('Product');
my $Version = $Self->{ConfigObject}->Get('Version');
if ( !$Self->{ConfigObject}->Get('Secure::DisableBanner') ) {
$Header{'X-Mailer'} = "$Product Mail Service ($Version)";
$Header{'X-Powered-By'} = 'OTRS - Open Ticket Request System (http://otrs.org/)';
}
$Header{Type} = $Param{MimeType} || 'text/plain';
# define email encoding
if ( $Param{Charset} && $Param{Charset} =~ /^iso/i ) {
$Header{Encoding} = '8bit';
}
else {
$Header{Encoding} = 'quoted-printable';
}
# check if we need to force the encoding
if ( $Self->{ConfigObject}->Get('SendmailEncodingForce') ) {
$Header{Encoding} = $Self->{ConfigObject}->Get('SendmailEncodingForce');
}
# check and create message id
if ( $Param{'Message-ID'} ) {
$Header{'Message-ID'} = $Param{'Message-ID'};
}
else {
$Header{'Message-ID'} = $Self->_MessageIDCreate();
}
# add date header
$Header{Date} = 'Date: ' . $Self->{TimeObject}->MailTimeStamp();
# add organisation header
my $Organization = $Self->{ConfigObject}->Get('Organization');
if ($Organization) {
$Header{Organization} = $Self->_EncodeMIMEWords(
Field => 'Organization',
Line => $Organization,
Charset => $Param{Charset},
);
}
# build MIME::Entity, Data should be bytes, not utf-8
# see http://bugs.otrs.org/show_bug.cgi?id=9832
$Self->{EncodeObject}->EncodeOutput( \$Param{Body} );
my $Entity = MIME::Entity->build( %Header, Data => $Param{Body} );
# set In-Reply-To and References header
my $Header = $Entity->head();
if ( $Param{InReplyTo} ) {
$Param{'In-Reply-To'} = $Param{InReplyTo};
}
for my $Key ( 'In-Reply-To', 'References' ) {
next if !$Param{$Key};
my $Value = $Param{$Key};
# Split up '<msgid><msgid>' to allow line folding (see bug#9345).
$Value =~ s{><}{> <}xmsg;
$Header->replace( $Key, $Value );
}
# add attachments to email
if ( $Param{Attachment} ) {
my $Count = 0;
my $PartType = '';
my @NewAttachments;
ATTACHMENT:
for my $Upload ( @{ $Param{Attachment} } ) {
# ignore attachment if no content is given
next ATTACHMENT if !defined $Upload->{Content};
# ignore attachment if no filename is given
next ATTACHMENT if !defined $Upload->{Filename};
# prepare ContentType for Entity Type. $Upload->{ContentType} has
# useless `name` parameter, we don't need to send it to the `attach`
# constructor. For more details see Bug #7879 and MIME::Entity.
# Note: we should remove `name` attribute only.
my @ContentTypeTmp = grep { !/\s*name=/ } ( split /;/, $Upload->{ContentType} );
$Upload->{ContentType} = join ';', @ContentTypeTmp;
# if it's a html email, add the first attachment as alternative (to show it
# as alternative content)
if ($HTMLEmail) {
$Count++;
if ( $Count == 1 ) {
$Entity->make_multipart('alternative;');
$PartType = 'alternative';
}
else {
# don't attach duplicate html attachment (aka file-2)
next ATTACHMENT if
$Upload->{Filename} eq 'file-2'
&& $Upload->{ContentType} =~ /html/i
&& $Upload->{Content} eq $Param{HTMLBody};
# skip, but remember all attachments except inline images
if ( !defined $Upload->{ContentID} ) {
push @NewAttachments, \%{$Upload};
next ATTACHMENT;
}
# add inline images as related
if ( $PartType ne 'related' ) {
$Entity->make_multipart( 'related;', Force => 1, );
$PartType = 'related';
}
}
}
# content encode
$Self->{EncodeObject}->EncodeOutput( \$Upload->{Content} );
# filename encode
my $Filename = $Self->_EncodeMIMEWords(
Field => 'filename',
Line => $Upload->{Filename},
Charset => $Param{Charset},
);
# format content id, leave undefined if no value
my $ContentID = $Upload->{ContentID};
if ( $ContentID && $ContentID !~ /^</ ) {
$ContentID = '<' . $ContentID . '>';
}
# attach file to email
$Entity->attach(
Filename => $Filename,
Data => $Upload->{Content},
Type => $Upload->{ContentType},
Id => $ContentID,
Disposition => $Upload->{Disposition} || 'inline',
Encoding => $Upload->{Encoding} || '-SUGGEST',
);
}
# add all other attachments as multipart mixed (if we had html body)
for my $Upload (@NewAttachments) {
# make multipart mixed
if ( $PartType ne 'mixed' ) {
$Entity->make_multipart( 'mixed;', Force => 1, );
$PartType = 'mixed';
}
# content encode
$Self->{EncodeObject}->EncodeOutput( \$Upload->{Content} );
# filename encode
my $Filename = $Self->_EncodeMIMEWords(
Field => 'filename',
Line => $Upload->{Filename},
Charset => $Param{Charset},
);
# attach file to email (no content id needed)
$Entity->attach(
Filename => $Filename,
Data => $Upload->{Content},
Type => $Upload->{ContentType},
Disposition => $Upload->{Disposition} || 'inline',
Encoding => $Upload->{Encoding} || '-SUGGEST',
);
}
}
# get sign options for detached
if ( $Param{Sign} && $Param{Sign}->{SubType} && $Param{Sign}->{SubType} eq 'Detached' ) {
my $CryptObject = Kernel::System::Crypt->new(
LogObject => $Self->{LogObject},
DBObject => $Self->{DBObject},
ConfigObject => $Self->{ConfigObject},
EncodeObject => $Self->{EncodeObject},
MainObject => $Self->{MainObject},
CryptType => $Param{Sign}->{Type},
);
if ( !$CryptObject ) {
$Self->{LogObject}->Log(
Message => 'Not possible to create crypt object',
Priority => 'error',
);
return;
}
if ( $Param{Sign}->{Type} eq 'PGP' ) {
# make_multipart -=> one attachment for sign
$Entity->make_multipart(
"signed; micalg=pgp-sha1; protocol=\"application/pgp-signature\";",
Force => 1,
);
# get string to sign
my $T = $Entity->parts(0)->as_string();
# according to RFC3156 all line endings MUST be CR/LF
$T =~ s/\x0A/\x0D\x0A/g;
$T =~ s/\x0D+/\x0D/g;
my $Sign = $CryptObject->Sign(
Message => $T,
Key => $Param{Sign}->{Key},
Type => 'Detached',
Charset => $Param{Charset},
);
# it sign failed, remove singned multi part
if ( !$Sign ) {
$Entity->make_singlepart();
}
else {
# addach sign to email
$Entity->attach(
Filename => 'pgp_sign.asc',
Data => $Sign,
Type => 'application/pgp-signature',
Encoding => '7bit',
);
}
}
elsif ( $Param{Sign}->{Type} eq 'SMIME' ) {
# make multi part
my $EntityCopy = $Entity->dup();
$EntityCopy->make_multipart( 'mixed;', Force => 1, );
# get header to remember
my $Head = $EntityCopy->head();
$Head->delete('MIME-Version');
$Head->delete('Content-Type');
$Head->delete('Content-Disposition');
$Head->delete('Content-Transfer-Encoding');
my $Header = $Head->as_string();
# get string to sign
my $T = $EntityCopy->parts(0)->as_string();
# according to RFC3156 all line endings MUST be CR/LF
$T =~ s/\x0A/\x0D\x0A/g;
$T =~ s/\x0D+/\x0D/g;
# remove empty line after multi-part preable as it will be removed later by MIME::Parser
# otherwise signed content will be different than the actual mail and verify will
# fail
$T =~ s{(This is a multi-part message in MIME format...\r\n)\r\n}{$1}g;
my $Sign = $CryptObject->Sign(
Message => $T,
Filename => $Param{Sign}->{Key},
Type => 'Detached',
);
if ($Sign) {
use MIME::Parser;
my $Parser = MIME::Parser->new();
$Parser->output_to_core('ALL');
$Parser->output_dir( $Self->{ConfigObject}->Get('TempDir') );
$Entity = $Parser->parse_data( $Header . $Sign );
}
}
}
# crypt detached!
#my $NotCryptedBody = $Entity->body_as_string();
if (
$Param{Crypt}
&& $Param{Crypt}->{Type}
&& $Param{Crypt}->{Type} eq 'PGP'
&& $Param{Crypt}->{SubType} eq 'Detached'
)
{
my $CryptObject = Kernel::System::Crypt->new(
LogObject => $Self->{LogObject},
DBObject => $Self->{DBObject},
ConfigObject => $Self->{ConfigObject},
EncodeObject => $Self->{EncodeObject},
MainObject => $Self->{MainObject},
CryptType => $Param{Crypt}->{Type},
);
return if !$CryptObject;
# make_multipart -=> one attachment for encryption
$Entity->make_multipart(
"encrypted; protocol=\"application/pgp-encrypted\";",
Force => 1,
);
# crypt it
my $Crypt = $CryptObject->Crypt(
Message => $Entity->parts(0)->as_string(),
# Key => '81877F5E',
# Key => '488A0B8F',
Key => $Param{Crypt}->{Key},
);
# it crypt failed, remove encrypted multi part
if ( !$Crypt ) {
$Entity->make_singlepart();
}
else {
# eliminate all parts
$Entity->parts( [] );
# add crypted parts
$Entity->attach(
Type => 'application/pgp-encrypted',
Disposition => 'attachment',
Data => [ "Version: 1", "" ],
Encoding => '7bit',
);
$Entity->attach(
Type => 'application/octet-stream',
Disposition => 'inline',
Filename => 'msg.asc',
Data => $Crypt,
Encoding => '7bit',
);
}
}
elsif ( $Param{Crypt} && $Param{Crypt}->{Type} && $Param{Crypt}->{Type} eq 'SMIME' ) {
my $CryptObject = Kernel::System::Crypt->new(
LogObject => $Self->{LogObject},
DBObject => $Self->{DBObject},
ConfigObject => $Self->{ConfigObject},
EncodeObject => $Self->{EncodeObject},
MainObject => $Self->{MainObject},
CryptType => $Param{Crypt}->{Type},
);
if ( !$CryptObject ) {
$Self->{LogObject}->Log(
Message => 'Failed creation of crypt object',
Priority => 'error',
);
return;
}
# make_multipart -=> one attachment for encryption
$Entity->make_multipart( 'mixed;', Force => 1, );
# get header to remember
my $Head = $Entity->head();
$Head->delete('MIME-Version');
$Head->delete('Content-Type');
$Head->delete('Content-Disposition');
$Head->delete('Content-Transfer-Encoding');
my $Header = $Head->as_string();
my $T = $Entity->parts(0)->as_string();
# according to RFC3156 all line endings MUST be CR/LF
$T =~ s/\x0A/\x0D\x0A/g;
$T =~ s/\x0D+/\x0D/g;
# crypt it
my $Crypt = $CryptObject->Crypt(
Message => $T,
Filename => $Param{Crypt}->{Key},
);
use MIME::Parser;
my $Parser = MIME::Parser->new();
$Parser->output_dir( $Self->{ConfigObject}->Get('TempDir') );
$Entity = $Parser->parse_data( $Header . $Crypt );
}
# get header from Entity
my $Head = $Entity->head();
$Param{Header} = $Head->as_string();
# remove not needed folding of email heads, we do have many problems with email clients
my @Headers = split( /\n/, $Param{Header} );
# reset orig header
$Param{Header} = '';
for my $Line (@Headers) {
$Line =~ s/^ (.*)$/ $1/;
$Param{Header} .= $Line . "\n";
}
# get body from Entity
$Param{Body} = $Entity->body_as_string();
# get recipients
my @ToArray;
my $To = '';
for (qw(To Cc Bcc)) {
next if !$Param{$_};
for my $Email ( Mail::Address->parse( $Param{$_} ) ) {
push( @ToArray, $Email->address() );
if ($To) {
$To .= ', ';
}
$To .= $Email->address();
}
}
# add Bcc recipients
my $SendmailBcc = $Self->{ConfigObject}->Get('SendmailBcc');
if ($SendmailBcc) {
push @ToArray, $SendmailBcc;
$To .= ', ' . $SendmailBcc;
}
# set envelope sender for replies
my $RealFrom = $Self->{ConfigObject}->Get('SendmailEnvelopeFrom') || '';
if ( !$RealFrom ) {
my @Sender = Mail::Address->parse( $Param{From} );
$RealFrom = $Sender[0]->address();
}
# set envelope sender for autoresponses and notifications
if ( $Param{Loop} ) {
$RealFrom = $Self->{ConfigObject}->Get('SendmailNotificationEnvelopeFrom') || '';
}
# debug
if ( $Self->{Debug} > 1 ) {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Sent email to '$To' from '$RealFrom'. Subject => '$Param{Subject}';",
);
}
# send email to backend
my $Sent = $Self->{Backend}->Send(
From => $RealFrom,
ToArray => \@ToArray,
Header => \$Param{Header},
Body => \$Param{Body},
);
if ( !$Sent ) {
$Self->{LogObject}->Log(
Message => "Error sending message",
Priority => 'info',
);
return;
}
return ( \$Param{Header}, \$Param{Body} );
}
=item Check()
Check mail configuration
my %Check = $SendObject->Check();
=cut
sub Check {
my ( $Self, %Param ) = @_;
my %Check = $Self->{Backend}->Check();
if ( $Check{Successful} ) {
return ( Successful => 1 )
}
else {
return ( Successful => 0, Message => $Check{Message} );
}
}
=item Bounce()
Bounce an email
$SendObject->Bounce(
From => 'me@example.com',
To => 'friend@example.com',
Email => $Email,
);
=cut
sub Bounce {
my ( $Self, %Param ) = @_;
# check needed stuff
for (qw(From To Email)) {
if ( !$Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
# check and create message id
my $MessageID = '';
if ( $Param{'Message-ID'} ) {
$MessageID = $Param{'Message-ID'};
}
else {
$MessageID = $Self->_MessageIDCreate();
}
# split body && header
my @EmailPlain = split( /\n/, $Param{Email} );
my $EmailObject = Mail::Internet->new( \@EmailPlain );
# get sender
my @Sender = Mail::Address->parse( $Param{From} );
my $RealFrom = $Sender[0]->address();
# add ReSent header
my $HeaderObject = $EmailObject->head();
my $OldMessageID = $HeaderObject->get('Message-ID') || '??';
$HeaderObject->replace( 'Message-ID', $MessageID );
$HeaderObject->replace( 'ReSent-Message-ID', $OldMessageID );
$HeaderObject->replace( 'Resent-To', $Param{To} );
$HeaderObject->replace( 'Resent-From', $RealFrom );
my $Body = $EmailObject->body();
my $BodyAsString = '';
for ( @{$Body} ) {
$BodyAsString .= $_ . "\n";
}
my $HeaderAsString = $HeaderObject->as_string();
# debug
if ( $Self->{Debug} > 1 ) {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Bounced email to '$Param{To}' from '$RealFrom'. "
. "MessageID => '$OldMessageID';",
);
}
my $Sent = $Self->{Backend}->Send(
From => $RealFrom,
ToArray => [ $Param{To} ],
Header => \$HeaderAsString,
Body => \$BodyAsString,
);
return if !$Sent;
return ( \$HeaderAsString, \$BodyAsString );
}
=begin Internal:
=cut
sub _EncodeMIMEWords {
my ( $Self, %Param ) = @_;
# return if no content is given
return '' if !defined $Param{Line};
# check if MIME::EncWords is installed
if ( eval { require MIME::EncWords } ) { ## no critic
return MIME::EncWords::encode_mimewords(
Encode::encode(
$Param{Charset},
$Param{Line},
),
Charset => $Param{Charset},
# use 'a' for quoted printable or base64 choice automatically
Encoding => 'a',
# for line length calculation to fold lines
Field => $Param{Field},
);
}
# as fallback use MIME::Words of MIME::Tools (but it lakes on some utf8
# issues, see pod of MIME::Words)
else {
require MIME::Words; ## no critic
return MIME::Words::encode_mimewords(
Encode::encode(
$Param{Charset},
$Param{Line},
),
Charset => $Param{Charset},
# for line length calculation to fold lines (gets ignored by
# MIME::Words, see pod of MIME::Words)
Field => $Param{Field},
);
}
}
sub _MessageIDCreate {
my ( $Self, %Param ) = @_;
my $FQDN = $Self->{ConfigObject}->Get('FQDN');
return 'Message-ID: <' . time() . '.' . rand(999999) . '@' . $FQDN . '>';
}
1;
=end Internal:
=back
=head1 TERMS AND CONDITIONS
This software is part of the OTRS project (L<http://otrs.org/>).
This software comes with ABSOLUTELY NO WARRANTY. For details, see
the enclosed file COPYING for license information (AGPL). If you
did not receive this file, see L<http://www.gnu.org/licenses/agpl.txt>.
=cut
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
Dann sollte der Code eigentlich funktionieren. Die Fehlermeldungen passen nicht zu dem Code, den Du vorhin gepostet hast. Kontrollier nochmal, dass Du die richtige User.pm geändert hast. Ansonsten weiß ich jetzt auch nicht, wie ich Dir über das Forum weiterhelfen kann..
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Habs überprüft stimmt alles. Das ist das was aktuelle im Apache - Log steht
[Tue Feb 17 14:20:10 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:20:16 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 16:57:09 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 16:57:14 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 16:58:26 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 16:58:31 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
ERROR: OTRS-CGI-40 Perl: 5.14.2 OS: linux Time: Tue Feb 17 17:00:55 2015
Message: Need Charset!
RemoteAddress: 10.176.6.119
RequestURI: /otrs/index.pl
Traceback (6503):
Module: Kernel::System::Email::Send (OTRS 3.3.10) Line: 176
Module: Kernel::System::User::UserAdd (OTRS 3.3.10) Line: 483
Module: Kernel::Modules::AdminUser::Run (OTRS 3.3.10) Line: 361
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 871
Module: ModPerl::ROOT::ModPerl::Registry::opt_otrs_bin_cgi_2dbin_index_2epl::handler (unknown version) Line: 49
Module: (eval) (v1.99) Line: 204
Module: ModPerl::RegistryCooker::run (v1.99) Line: 204
Module: ModPerl::RegistryCooker::default_handler (v1.99) Line: 170
Module: ModPerl::Registry::handler (v1.99) Line: 31
Falls das nicht weiterhilft, dann bedank ich mich trotzdem für die Hilfe
[Tue Feb 17 14:20:10 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 14:20:16 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 16:57:09 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 16:57:14 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
[Tue Feb 17 16:58:26 2015] [notice] caught SIGTERM, shutting down
[Tue Feb 17 16:58:31 2015] [notice] Apache/2.2.22 (Debian) mod_perl/2.0.7 Perl/v5.14.2 configured -- resuming normal operations
ERROR: OTRS-CGI-40 Perl: 5.14.2 OS: linux Time: Tue Feb 17 17:00:55 2015
Message: Need Charset!
RemoteAddress: 10.176.6.119
RequestURI: /otrs/index.pl
Traceback (6503):
Module: Kernel::System::Email::Send (OTRS 3.3.10) Line: 176
Module: Kernel::System::User::UserAdd (OTRS 3.3.10) Line: 483
Module: Kernel::Modules::AdminUser::Run (OTRS 3.3.10) Line: 361
Module: Kernel::System::Web::InterfaceAgent::Run (OTRS 3.3.10) Line: 871
Module: ModPerl::ROOT::ModPerl::Registry::opt_otrs_bin_cgi_2dbin_index_2epl::handler (unknown version) Line: 49
Module: (eval) (v1.99) Line: 204
Module: ModPerl::RegistryCooker::run (v1.99) Line: 204
Module: ModPerl::RegistryCooker::default_handler (v1.99) Line: 170
Module: ModPerl::Registry::handler (v1.99) Line: 31
Falls das nicht weiterhilft, dann bedank ich mich trotzdem für die Hilfe

Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
-
- Znuny guru
- Posts: 5018
- Joined: 13 Mar 2011, 09:54
- Znuny Version: 6.0.x
- Real Name: Renée Bäcker
- Company: Perl-Services.de
- Contact:
Re: Agenten Erstellung automatische Email
Ok, das sieht schon besser aus. Jetzt ersetze noch mit , dann sollte es passen...
Code: Select all
$Self->{LayoutObject}->{UserCharset}
Code: Select all
'utf-8'
Perl / Znuny development: http://perl-services.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
Free Znuny add ons from the community: http://opar.perl-services.de
Commercial add ons: http://feature-addons.de
-
- Znuny newbie
- Posts: 32
- Joined: 14 Jan 2015, 12:20
- Znuny Version: 3.3.10
- Real Name: Marco
- Company: DB
Re: Agenten Erstellung automatische Email
Es funktioniert! Vielen Dank für deine Geduld und deine Hilfe =).
Für alle, die die selbe Funktion umsetzen möchten, hier der Code:
Für alle, die die selbe Funktion umsetzen möchten, hier der Code:
Code: Select all
# --
# Kernel/System/User.pm - some user functions
# Copyright (C) 2001-2014 xxx, http://otrs.com/
# --
# This software comes with ABSOLUTELY NO WARRANTY. For details, see
# the enclosed file COPYING for license information (AGPL). If you
# did not receive this file, see http://www.gnu.org/licenses/agpl.txt.
# --
package Kernel::System::User;
use strict;
use warnings;
use Crypt::PasswdMD5 qw(unix_md5_crypt);
use Digest::SHA;
use Kernel::System::CacheInternal;
use Kernel::System::CheckItem;
use Kernel::System::Email;
=head1 NAME
Kernel::System::User - user lib
=head1 SYNOPSIS
All user functions. E. g. to add and updated user and other functions.
=head1 PUBLIC INTERFACE
=over 4
=cut
=item new()
create an object
use Kernel::Config;
use Kernel::System::Encode;
use Kernel::System::Log;
use Kernel::System::Main;
use Kernel::System::Time;
use Kernel::System::DB;
use Kernel::System::User;
my $ConfigObject = Kernel::Config->new();
my $EncodeObject = Kernel::System::Encode->new(
ConfigObject => $ConfigObject,
);
my $LogObject = Kernel::System::Log->new(
ConfigObject => $ConfigObject,
EncodeObject => $EncodeObject,
);
my $MainObject = Kernel::System::Main->new(
ConfigObject => $ConfigObject,
EncodeObject => $EncodeObject,
LogObject => $LogObject,
);
my $TimeObject = Kernel::System::Time->new(
ConfigObject => $ConfigObject,
LogObject => $LogObject,
);
my $DBObject = Kernel::System::DB->new(
ConfigObject => $ConfigObject,
EncodeObject => $EncodeObject,
LogObject => $LogObject,
MainObject => $MainObject,
);
my $UserObject = Kernel::System::User->new(
ConfigObject => $ConfigObject,
LogObject => $LogObject,
MainObject => $MainObject,
TimeObject => $TimeObject,
DBObject => $DBObject,
EncodeObject => $EncodeObject,
);
=cut
sub new {
my ( $Type, %Param ) = @_;
# allocate new hash for object
my $Self = {};
bless( $Self, $Type );
# check needed objects
for (qw(DBObject ConfigObject LogObject TimeObject MainObject EncodeObject)) {
$Self->{$_} = $Param{$_} || die "Got no $_!";
}
$Self->{SendmailObject} = Kernel::System::Email->new(%{$Self});
# get user table
$Self->{UserTable} = $Self->{ConfigObject}->Get('DatabaseUserTable') || 'user';
$Self->{UserTableUserID} = $Self->{ConfigObject}->Get('DatabaseUserTableUserID') || 'id';
$Self->{UserTableUserPW} = $Self->{ConfigObject}->Get('DatabaseUserTableUserPW') || 'pw';
$Self->{UserTableUser} = $Self->{ConfigObject}->Get('DatabaseUserTableUser') || 'login';
# create needed object
$Self->{ValidObject} = Kernel::System::Valid->new( %{$Self} );
$Self->{CheckItemObject} = Kernel::System::CheckItem->new( %{$Self} );
$Self->{CacheInternalObject} = Kernel::System::CacheInternal->new(
%{$Self},
Type => 'User',
TTL => 60 * 60 * 3,
);
# set lower if database is case sensitive
$Self->{Lower} = '';
if ( $Self->{DBObject}->GetDatabaseFunction('CaseSensitive') ) {
$Self->{Lower} = 'LOWER';
}
# load generator preferences module
my $GeneratorModule = $Self->{ConfigObject}->Get('User::PreferencesModule')
|| 'Kernel::System::User::Preferences::DB';
if ( $Self->{MainObject}->Require($GeneratorModule) ) {
$Self->{PreferencesObject} = $GeneratorModule->new( %{$Self} );
}
return $Self;
}
=item GetUserData()
get user data (UserLogin, UserFirstname, UserLastname, UserEmail, ...)
my %User = $UserObject->GetUserData(
UserID => 123,
);
or
my %User = $UserObject->GetUserData(
User => 'franz',
Valid => 1, # not required -> 0|1 (default 0)
# returns only data if user is valid
NoOutOfOffice => 1, # not required -> 0|1 (default 0)
# returns data without out of office infos
);
=cut
sub GetUserData {
my ( $Self, %Param ) = @_;
# check needed stuff
if ( !$Param{User} && !$Param{UserID} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'Need User or UserID!' );
return;
}
# get configuration for the full name order
my $FirstnameLastNameOrder = $Self->{ConfigObject}->Get('FirstnameLastnameOrder') || 0;
# check if result is cached
if ( $Param{Valid} ) {
$Param{Valid} = 1;
}
else {
$Param{Valid} = 0;
}
if ( $Param{NoOutOfOffice} ) {
$Param{NoOutOfOffice} = 1;
}
else {
$Param{NoOutOfOffice} = 0;
}
my $CacheKey;
if ( $Param{User} ) {
$CacheKey
= 'GetUserData::User::'
. $Param{User} . '::'
. $Param{Valid} . '::'
. $FirstnameLastNameOrder . '::'
. $Param{NoOutOfOffice};
}
else {
$CacheKey
= 'GetUserData::UserID::'
. $Param{UserID} . '::'
. $Param{Valid} . '::'
. $FirstnameLastNameOrder . '::'
. $Param{NoOutOfOffice};
}
# check cache
my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
return %{$Cache} if $Cache;
# get initial data
my @Bind;
my $SQL = "SELECT $Self->{UserTableUserID}, $Self->{UserTableUser}, "
. " title, first_name, last_name, $Self->{UserTableUserPW}, valid_id, "
. " create_time, change_time FROM $Self->{UserTable} WHERE ";
if ( $Param{User} ) {
my $User = lc $Param{User};
$SQL .= " $Self->{Lower}($Self->{UserTableUser}) = ?";
push @Bind, \$User;
}
else {
$SQL .= " $Self->{UserTableUserID} = ?";
push @Bind, \$Param{UserID};
}
return if !$Self->{DBObject}->Prepare(
SQL => $SQL,
Bind => \@Bind,
Limit => 1,
);
my %Data;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
$Data{UserID} = $Row[0];
$Data{UserLogin} = $Row[1];
$Data{UserTitle} = $Row[2];
$Data{UserFirstname} = $Row[3];
$Data{UserLastname} = $Row[4];
$Data{UserPw} = $Row[5];
$Data{ValidID} = $Row[6];
$Data{CreateTime} = $Row[7];
$Data{ChangeTime} = $Row[8];
}
# check data
if ( !$Data{UserID} ) {
if ( $Param{User} ) {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Panic! No UserData for user: '$Param{User}'!!!",
);
return;
}
else {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Panic! No UserData for user id: '$Param{UserID}'!!!",
);
return;
}
}
# check valid, return if there is locked for valid users
if ( $Param{Valid} ) {
my $Hit = 0;
for ( $Self->{ValidObject}->ValidIDsGet() ) {
if ( $_ eq $Data{ValidID} ) {
$Hit = 1;
}
}
if ( !$Hit ) {
# set cache
$Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => {} );
return;
}
}
# generate the full name and save it in the hash
my $UserFullname;
if ( $FirstnameLastNameOrder eq '0' ) {
$UserFullname = $Data{UserFirstname} . ' '
. $Data{UserLastname};
}
elsif ( $FirstnameLastNameOrder eq '1' ) {
$UserFullname = $Data{UserLastname} . ', '
. $Data{UserFirstname};
}
elsif ( $FirstnameLastNameOrder eq '2' ) {
$UserFullname = $Data{UserFirstname} . ' '
. $Data{UserLastname} . ' ('
. $Data{UserLogin} . ')';
}
elsif ( $FirstnameLastNameOrder eq '3' ) {
$UserFullname = $Data{UserLastname} . ', '
. $Data{UserFirstname} . ' ('
. $Data{UserLogin} . ')';
}
elsif ( $FirstnameLastNameOrder eq '4' ) {
$UserFullname = '(' . $Data{UserLogin}
. ') ' . $Data{UserFirstname}
. ' ' . $Data{UserLastname};
}
elsif ( $FirstnameLastNameOrder eq '5' ) {
$UserFullname = '(' . $Data{UserLogin}
. ') ' . $Data{UserLastname}
. ', ' . $Data{UserFirstname};
}
# save the generated fullname in the hash.
$Data{UserFullname} = $UserFullname;
# get preferences
my %Preferences = $Self->GetPreferences( UserID => $Data{UserID} );
# add last login timestamp
if ( $Preferences{UserLastLogin} ) {
$Preferences{UserLastLoginTimestamp} = $Self->{TimeObject}->SystemTime2TimeStamp(
SystemTime => $Preferences{UserLastLogin},
);
}
# check compat stuff
if ( !$Preferences{UserEmail} ) {
$Preferences{UserEmail} = $Data{UserLogin};
}
# out of office check
if ( !$Param{NoOutOfOffice} ) {
if ( $Preferences{OutOfOffice} ) {
my $Time = $Self->{TimeObject}->SystemTime();
my $Start
= "$Preferences{OutOfOfficeStartYear}-$Preferences{OutOfOfficeStartMonth}-$Preferences{OutOfOfficeStartDay} 00:00:00";
my $TimeStart = $Self->{TimeObject}->TimeStamp2SystemTime(
String => $Start,
);
my $End
= "$Preferences{OutOfOfficeEndYear}-$Preferences{OutOfOfficeEndMonth}-$Preferences{OutOfOfficeEndDay} 23:59:59";
my $TimeEnd = $Self->{TimeObject}->TimeStamp2SystemTime(
String => $End,
);
my $Till = int( ( $TimeEnd - $Time ) / 60 / 60 / 24 );
my $TillDate
= "$Preferences{OutOfOfficeEndYear}-$Preferences{OutOfOfficeEndMonth}-$Preferences{OutOfOfficeEndDay}";
if ( $TimeStart < $Time && $TimeEnd > $Time ) {
$Preferences{OutOfOfficeMessage} = "*** out of office till $TillDate/$Till d ***";
$Data{UserLastname} .= ' ' . $Preferences{OutOfOfficeMessage};
}
}
}
# merge hash
%Data = ( %Data, %Preferences );
# add preferences defaults
my $Config = $Self->{ConfigObject}->Get('PreferencesGroups');
if ( $Config && ref $Config eq 'HASH' ) {
for my $Key ( sort keys %{$Config} ) {
# next if no default data exists
next if !defined $Config->{$Key}->{DataSelected};
# check if data is defined
next if defined $Data{ $Config->{$Key}->{PrefKey} };
# set default data
$Data{ $Config->{$Key}->{PrefKey} } = $Config->{$Key}->{DataSelected};
}
}
# set cache
$Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => \%Data );
return %Data;
}
=item UserAdd()
to add new users
my $UserID = $UserObject->UserAdd(
UserFirstname => 'Huber',
UserLastname => 'Manfred',
UserLogin => 'mhuber',
UserPw => 'some-pass', # not required
UserEmail => 'email@example.com',
ValidID => 1,
ChangeUserID => 123,
);
=cut
sub UserAdd {
my ( $Self, %Param ) = @_;
# check needed stuff
for (qw(UserFirstname UserLastname UserLogin UserEmail ValidID ChangeUserID)) {
if ( !$Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
# check if a user with this login (username) already exits
if ( $Self->UserLoginExistsCheck( UserLogin => $Param{UserLogin} ) ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => "A user with username '$Param{UserLogin}' already exists!"
);
return;
}
# check email address
if (
$Param{UserEmail}
&& !$Self->{CheckItemObject}->CheckEmail( Address => $Param{UserEmail} )
)
{
$Self->{LogObject}->Log(
Priority => 'error',
Message => "Email address ($Param{UserEmail}) not valid ("
. $Self->{CheckItemObject}->CheckError() . ")!",
);
return;
}
# check password
if ( !$Param{UserPw} ) {
$Param{UserPw} = $Self->GenerateRandomPassword();
}
# sql
return if !$Self->{DBObject}->Do(
SQL => "INSERT INTO $Self->{UserTable} "
. "(title, first_name, last_name, "
. " $Self->{UserTableUser}, $Self->{UserTableUserPW}, "
. " valid_id, create_time, create_by, change_time, change_by)"
. " VALUES "
. " (?, ?, ?, ?, ?, ?, current_timestamp, ?, current_timestamp, ?)",
Bind => [
\$Param{UserTitle}, \$Param{UserFirstname}, \$Param{UserLastname},
\$Param{UserLogin}, \$Param{UserPw}, \$Param{ValidID},
\$Param{ChangeUserID}, \$Param{ChangeUserID},
],
);
# get new user id
my $UserLogin = lc $Param{UserLogin};
return if !$Self->{DBObject}->Prepare(
SQL => "SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} "
. " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
Bind => [ \$UserLogin ],
Limit => 1,
);
# fetch the result
my $UserID;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
$UserID = $Row[0];
}
# check if user exists
if ( !$UserID ) {
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "Unable to create User: '$Param{UserLogin}' ($Param{ChangeUserID})!",
);
return;
}
# log notice
$Self->{LogObject}->Log(
Priority => 'notice',
Message =>
"User: '$Param{UserLogin}' ID: '$UserID' created successfully ($Param{ChangeUserID})!",
);
# set password
$Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );
# set email address
$Self->SetPreferences( UserID => $UserID, Key => 'UserEmail', Value => $Param{UserEmail} );
# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
#send email
my $ContentType = 'text/plain';
my $Sent = $Self->{SendmailObject}->Send(
From => $Self->{ConfigObject}->Get('NotificationSenderEmail'),
To => $Param{UserEmail},
Subject => 'OTRS account',
Charset => 'utf-8',
MimeType => $ContentType,
Body => 'Name und PW',
);
return $UserID;
}
=item UserUpdate()
to update users
$UserObject->UserUpdate(
UserID => 4321,
UserFirstname => 'Huber',
UserLastname => 'Manfred',
UserLogin => 'mhuber',
UserPw => 'some-pass', # not required
UserEmail => 'email@example.com',
ValidID => 1,
ChangeUserID => 123,
);
=cut
sub UserUpdate {
my ( $Self, %Param ) = @_;
# check needed stuff
for (qw(UserID UserFirstname UserLastname UserLogin ValidID ChangeUserID)) {
if ( !$Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
# check if a user with this login (username) already exits
if ( $Self->UserLoginExistsCheck( UserLogin => $Param{UserLogin}, UserID => $Param{UserID} ) ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => "A user with username '$Param{UserLogin}' already exists!"
);
return;
}
# check email address
if (
$Param{UserEmail}
&& !$Self->{CheckItemObject}->CheckEmail( Address => $Param{UserEmail} )
)
{
$Self->{LogObject}->Log(
Priority => 'error',
Message => "Email address ($Param{UserEmail}) not valid ("
. $Self->{CheckItemObject}->CheckError() . ")!",
);
return;
}
# update db
return if !$Self->{DBObject}->Do(
SQL => "UPDATE $Self->{UserTable} SET title = ?, first_name = ?, last_name = ?, "
. " $Self->{UserTableUser} = ?, valid_id = ?, "
. " change_time = current_timestamp, change_by = ? "
. " WHERE $Self->{UserTableUserID} = ?",
Bind => [
\$Param{UserTitle}, \$Param{UserFirstname}, \$Param{UserLastname},
\$Param{UserLogin}, \$Param{ValidID}, \$Param{ChangeUserID}, \$Param{UserID},
],
);
# log notice
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "User: '$Param{UserLogin}' updated successfully ($Param{ChangeUserID})!",
);
# check pw
if ( $Param{UserPw} ) {
$Self->SetPassword( UserLogin => $Param{UserLogin}, PW => $Param{UserPw} );
}
# set email address
$Self->SetPreferences(
UserID => $Param{UserID},
Key => 'UserEmail',
Value => $Param{UserEmail}
);
# delete cache
$Self->{CacheInternalObject}->CleanUp();
$Self->{CacheInternalObject}->CleanUp( OtherType => 'Group' );
return 1;
}
=item UserSearch()
to search users
my %List = $UserObject->UserSearch(
Search => '*some*', # also 'hans+huber' possible
Valid => 1, # not required
);
my %List = $UserObject->UserSearch(
UserLogin => '*some*',
Limit => 50,
Valid => 1, # not required
);
my %List = $UserObject->UserSearch(
PostMasterSearch => 'email@example.com',
Valid => 1, # not required
);
=cut
sub UserSearch {
my ( $Self, %Param ) = @_;
my %Users;
my $Valid = defined $Param{Valid} ? $Param{Valid} : 1;
# check needed stuff
if ( !$Param{Search} && !$Param{UserLogin} && !$Param{PostMasterSearch} ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => 'Need Search, UserLogin or PostMasterSearch!',
);
return;
}
# get like escape string needed for some databases (e.g. oracle)
my $LikeEscapeString = $Self->{DBObject}->GetDatabaseFunction('LikeEscapeString');
# build SQL string 1/2
my $SQL = "SELECT $Self->{UserTableUserID} ";
my @Fields = qw(login first_name last_name);
if (@Fields) {
for my $Entry (@Fields) {
$SQL .= ", $Entry";
}
}
# build SQL string 2/2
$SQL .= " FROM $Self->{UserTable} WHERE ";
if ( $Param{Search} ) {
$SQL .= $Self->{DBObject}->QueryCondition(
Key => \@Fields,
Value => $Param{Search},
) . ' ';
}
elsif ( $Param{PostMasterSearch} ) {
my %UserID = $Self->SearchPreferences(
Key => 'UserEmail',
Value => $Param{PostMasterSearch},
);
for ( sort keys %UserID ) {
my %User = $Self->GetUserData(
UserID => $_,
Valid => $Param{Valid},
);
if (%User) {
return %UserID;
}
}
return;
}
elsif ( $Param{UserLogin} ) {
$Param{UserLogin} =~ s/\*/%/g;
$SQL .= " $Self->{Lower}($Self->{UserTableUser}) LIKE $Self->{Lower}('"
. $Self->{DBObject}->Quote( $Param{UserLogin}, 'Like' ) . "') $LikeEscapeString";
}
# add valid option
if ($Valid) {
$SQL .= "AND valid_id IN (" . join( ', ', $Self->{ValidObject}->ValidIDsGet() ) . ")";
}
# get data
return if !$Self->{DBObject}->Prepare(
SQL => $SQL,
Limit => $Self->{UserSearchListLimit} || $Param{Limit},
);
# fetch the result
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
for ( 1 .. 8 ) {
if ( $Row[$_] ) {
$Users{ $Row[0] } .= $Row[$_] . ' ';
}
}
$Users{ $Row[0] } =~ s/^(.*)\s(.+?\@.+?\..+?)(\s|)$/"$1" <$2>/;
}
return %Users;
}
=item SetPassword()
to set users passwords
$UserObject->SetPassword(
UserLogin => 'some-login',
PW => 'some-new-password'
);
=cut
sub SetPassword {
my ( $Self, %Param ) = @_;
# check needed stuff
if ( !$Param{UserLogin} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'Need UserLogin!' );
return;
}
# get old user data
my %User = $Self->GetUserData( User => $Param{UserLogin} );
if ( !$User{UserLogin} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'No such User!' );
return;
}
my $Pw = $Param{PW} || '';
my $CryptedPw = '';
# get crypt type
my $CryptType = $Self->{ConfigObject}->Get('AuthModule::DB::CryptType') || 'sha2';
# crypt plain (no crypt at all)
if ( $CryptType eq 'plain' ) {
$CryptedPw = $Pw;
}
# crypt with unix crypt
elsif ( $CryptType eq 'crypt' ) {
# encode output, needed by crypt() only non utf8 signs
$Self->{EncodeObject}->EncodeOutput( \$Pw );
$Self->{EncodeObject}->EncodeOutput( \$Param{UserLogin} );
$CryptedPw = crypt( $Pw, $Param{UserLogin} );
}
# crypt with md5
elsif ( $CryptType eq 'md5' || !$CryptType ) {
# encode output, needed by unix_md5_crypt() only non utf8 signs
$Self->{EncodeObject}->EncodeOutput( \$Pw );
$Self->{EncodeObject}->EncodeOutput( \$Param{UserLogin} );
$CryptedPw = unix_md5_crypt( $Pw, $Param{UserLogin} );
}
# crypt with sha1
elsif ( $CryptType eq 'sha1' ) {
my $SHAObject = Digest::SHA->new('sha1');
# encode output, needed by sha1_hex() only non utf8 signs
$Self->{EncodeObject}->EncodeOutput( \$Pw );
$SHAObject->add($Pw);
$CryptedPw = $SHAObject->hexdigest();
}
# bcrypt
elsif ( $CryptType eq 'bcrypt' ) {
if ( !$Self->{MainObject}->Require('Crypt::Eksblowfish::Bcrypt') ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message =>
"User: '$User{UserLogin}' tried to store password with bcrypt but 'Crypt::Eksblowfish::Bcrypt' is not installed!",
);
return;
}
my $Cost = 9;
my $Salt = $Self->{MainObject}->GenerateRandomString( Length => 16 );
# remove UTF8 flag, required by Crypt::Eksblowfish::Bcrypt
$Self->{EncodeObject}->EncodeOutput( \$Pw );
# calculate password hash
my $Octets = Crypt::Eksblowfish::Bcrypt::bcrypt_hash(
{
key_nul => 1,
cost => 9,
salt => $Salt,
},
$Pw
);
# We will store cost and salt in the password string so that it can be decoded
# in future even if we use a higher cost by default.
$CryptedPw = "BCRYPT:$Cost:$Salt:" . Crypt::Eksblowfish::Bcrypt::en_base64($Octets);
}
# crypt with sha256 as fallback
else {
my $SHAObject = Digest::SHA->new('sha256');
# encode output, needed by sha256_hex() only non utf8 signs
$Self->{EncodeObject}->EncodeOutput( \$Pw );
$SHAObject->add($Pw);
$CryptedPw = $SHAObject->hexdigest();
}
# update db
my $UserLogin = lc $Param{UserLogin};
return if !$Self->{DBObject}->Do(
SQL => "UPDATE $Self->{UserTable} SET $Self->{UserTableUserPW} = ? "
. " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
Bind => [ \$CryptedPw, \$UserLogin ],
);
# log notice
$Self->{LogObject}->Log(
Priority => 'notice',
Message => "User: '$Param{UserLogin}' changed password successfully!",
);
return 1;
}
=item UserLookup()
user login or id lookup
my $UserLogin = $UserObject->UserLookup(
UserID => 1,
);
my $UserID = $UserObject->UserLookup(
UserLogin => 'some_user_login',
);
=cut
sub UserLookup {
my ( $Self, %Param ) = @_;
# check needed stuff
if ( !$Param{UserLogin} && !$Param{UserID} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'Need UserLogin or UserID!' );
return;
}
if ( $Param{UserLogin} ) {
# check cache
my $CacheKey = 'UserLookup::ID::' . $Param{UserLogin};
my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
return $Cache if $Cache;
# build sql query
my $UserLogin = lc $Param{UserLogin};
return if !$Self->{DBObject}->Prepare(
SQL => "SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} "
. " WHERE $Self->{Lower}($Self->{UserTableUser}) = ?",
Bind => [ \$UserLogin ],
Limit => 1,
);
# fetch the result
my $ID;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
$ID = $Row[0];
}
if ( !$ID ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => "No UserID found for '$Param{UserLogin}'!",
);
return;
}
# set cache
$Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => $ID );
return $ID;
}
else {
# check cache
my $CacheKey = 'UserLookup::Login::' . $Param{UserID};
my $Cache = $Self->{CacheInternalObject}->Get( Key => $CacheKey );
return $Cache if $Cache;
# build sql query
return if !$Self->{DBObject}->Prepare(
SQL => "SELECT $Self->{UserTableUser} FROM $Self->{UserTable} "
. " WHERE $Self->{UserTableUserID} = ?",
Bind => [ \$Param{UserID} ],
Limit => 1,
);
# fetch the result
my $Login;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
$Login = $Row[0];
}
if ( !$Login ) {
$Self->{LogObject}->Log(
Priority => 'error',
Message => "No UserLogin found for '$Param{UserID}'!",
);
return;
}
# set cache
$Self->{CacheInternalObject}->Set( Key => $CacheKey, Value => $Login );
return $Login;
}
}
=item UserName()
get user name
my $Name = $UserObject->UserName(
UserLogin => 'some-login',
);
or
my $Name = $UserObject->UserName(
UserID => 123,
);
=cut
sub UserName {
my ( $Self, %Param ) = @_;
my %User = $Self->GetUserData(%Param);
return if !%User;
return $User{UserFullname};
}
=item UserList()
return a hash with all users
my %List = $UserObject->UserList(
Type => 'Short', # Short|Long, default Short
Valid => 1, # not required, default 0
);
=cut
sub UserList {
my ( $Self, %Param ) = @_;
my $Type = $Param{Type} || 'Short';
# set valid option
my $Valid = $Param{Valid};
if ( !defined $Valid || $Valid ) {
$Valid = 1;
}
else {
$Valid = 0;
}
# get configuration for the full name order
my $FirstnameLastNameOrder = $Self->{ConfigObject}->Get('FirstnameLastnameOrder') || 0;
# check cache
my $CacheKey = 'UserList::' . $Type . '::' . $Valid
. '::' . $FirstnameLastNameOrder;
my $Cache = $Self->{CacheInternalObject}->Get(
Key => $CacheKey,
);
return %{$Cache} if $Cache;
my $SelectStr;
if ( $Type eq 'Short' ) {
$SelectStr = "$Self->{ConfigObject}->{DatabaseUserTableUserID}, "
. " $Self->{ConfigObject}->{DatabaseUserTableUser}";
}
else {
$SelectStr = "$Self->{ConfigObject}->{DatabaseUserTableUserID}, "
. " last_name, first_name, "
. " $Self->{ConfigObject}->{DatabaseUserTableUser}";
}
# sql query
if ($Valid) {
return if !$Self->{DBObject}->Prepare(
SQL =>
"SELECT $SelectStr FROM $Self->{ConfigObject}->{DatabaseUserTable} WHERE valid_id IN "
. "( ${\(join ', ', $Self->{ValidObject}->ValidIDsGet())} )",
);
}
else {
return if !$Self->{DBObject}->Prepare(
SQL => "SELECT $SelectStr FROM $Self->{ConfigObject}->{DatabaseUserTable}",
);
}
# fetch the result
my %UsersRaw;
my %Users;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
$UsersRaw{ $Row[0] } = $Row[1];
}
if ( $Type eq 'Short' ) {
%Users = %UsersRaw;
}
else {
for my $CurrentUserID ( sort keys %UsersRaw ) {
my $UserFullname = $Self->UserName( UserID => $CurrentUserID );
$Users{$CurrentUserID} = $UserFullname;
}
}
# check vacation option
for my $UserID ( sort keys %Users ) {
next if !$UserID;
my %User = $Self->GetUserData(
UserID => $UserID,
);
if ( $User{OutOfOfficeMessage} ) {
$Users{$UserID} .= ' ' . $User{OutOfOfficeMessage};
}
}
# set cache
$Self->{CacheInternalObject}->Set(
Key => $CacheKey,
Value => \%Users,
);
return %Users;
}
=item GenerateRandomPassword()
generate a random password
my $Password = $UserObject->GenerateRandomPassword();
or
my $Password = $UserObject->GenerateRandomPassword(
Size => 16,
);
=cut
sub GenerateRandomPassword {
my ( $Self, %Param ) = @_;
# Generated passwords are eight characters long by default.
my $Size = $Param{Size} || 8;
my $Password = $Self->{MainObject}->GenerateRandomString(
Length => $Size,
);
# Return the password.
return $Password;
}
=item SetPreferences()
set user preferences
$UserObject->SetPreferences(
Key => 'UserComment',
Value => 'some comment',
UserID => 123,
);
=cut
sub SetPreferences {
my ( $Self, %Param ) = @_;
# check needed stuff
for (qw(Key UserID)) {
if ( !$Param{$_} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need $_!" );
return;
}
}
# get current setting
my %User = $Self->GetUserData(
UserID => $Param{UserID},
NoOutOfOffice => 1,
);
# no updated needed
return 1
if defined $User{ $Param{Key} }
&& defined $Param{Value}
&& $User{ $Param{Key} } eq $Param{Value};
# delete cache
my $Login = $Self->UserLookup( UserID => $Param{UserID} );
$Self->{CacheInternalObject}->CleanUp();
# set preferences
return $Self->{PreferencesObject}->SetPreferences(%Param);
}
=item GetPreferences()
get user preferences
my %Preferences = $UserObject->GetPreferences(
UserID => 123,
);
=cut
sub GetPreferences {
my ( $Self, %Param ) = @_;
return $Self->{PreferencesObject}->GetPreferences(%Param);
}
=item SearchPreferences()
search in user preferences
my %UserList = $UserObject->SearchPreferences(
Key => 'UserEmail',
Value => 'email@example.com', # optional, limit to a certain value/pattern
);
=cut
sub SearchPreferences {
my $Self = shift;
return $Self->{PreferencesObject}->SearchPreferences(@_);
}
=item TokenGenerate()
generate a random token
my $Token = $UserObject->TokenGenerate(
UserID => 123,
);
=cut
sub TokenGenerate {
my ( $Self, %Param ) = @_;
# check needed stuff
if ( !$Param{UserID} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => "Need UserID!" );
return;
}
my $Token = $Self->{MainObject}->GenerateRandomString(
Length => 15,
);
# save token in preferences
$Self->SetPreferences(
Key => 'UserToken',
Value => $Token,
UserID => $Param{UserID},
);
return $Token;
}
=item TokenCheck()
check password token
my $Valid = $UserObject->TokenCheck(
Token => $Token,
UserID => 123,
);
=cut
sub TokenCheck {
my ( $Self, %Param ) = @_;
# check needed stuff
if ( !$Param{Token} || !$Param{UserID} ) {
$Self->{LogObject}->Log( Priority => 'error', Message => 'Need Token and UserID!' );
return;
}
# get preferences token
my %Preferences = $Self->GetPreferences(
UserID => $Param{UserID},
);
# check requested vs. stored token
if ( $Preferences{UserToken} && $Preferences{UserToken} eq $Param{Token} ) {
# reset password token
$Self->SetPreferences(
Key => 'UserToken',
Value => '',
UserID => $Param{UserID},
);
# return true if token is valid
return 1;
}
# return false if token is invalid
return;
}
=item UserLoginExistsCheck()
return 1 if another user with this login (username) already exits
$Exist = $UserObject->UserLoginExistsCheck(
UserLogin => 'Some::UserLogin',
UserID => 1, # optional
);
=cut
sub UserLoginExistsCheck {
my ( $Self, %Param ) = @_;
return if !$Self->{DBObject}->Prepare(
SQL =>
"SELECT $Self->{UserTableUserID} FROM $Self->{UserTable} WHERE $Self->{UserTableUser} = ?",
Bind => [ \$Param{UserLogin} ],
);
# fetch the result
my $Flag;
while ( my @Row = $Self->{DBObject}->FetchrowArray() ) {
if ( !$Param{UserID} || $Param{UserID} ne $Row[0] ) {
$Flag = 1;
}
}
if ($Flag) {
return 1;
}
return 0;
}
1;
=back
=head1 TERMS AND CONDITIONS
This software is part of the OTRS project (L<http://otrs.org/>).
This software comes with ABSOLUTELY NO WARRANTY. For details, see
the enclosed file COPYING for license information (AGPL). If you
did not receive this file, see L<http://www.gnu.org/licenses/agpl.txt>.
=cut
Greetings
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.
Marco
Im running OTRS::ITSM 3.3.10 on Debian 7.4.