App-MonM

 view release on metacpan or  search on metacpan

bin/monmd  view on Meta::CPAN

my $ddir = $ctk->datadir;
exit 1 unless CTK::Util::preparedir( $ddir );

# User and Group
my $usr = lvalue($ctk->config("daemonuser")) || USERNAME;
my $grp = lvalue($ctk->config("daemongroup")) || GROUPNAME;

# Set permisions (GID and UID) for work directory
my $uid = getpwnam($usr) || die "getpwnam failed - $!\n";
if ((stat($ddir))[4] != $uid) {
    my $gid = getgrnam($grp) || die "getgrnam failed - $!\n";
    chown($uid, $gid, $ddir);
}

# Daemon
my $daemon = App::MonM::Daemon->new(DAEMONMAME,
        ctk     => $ctk,
        forks   => lvalue($ctk->config("workers")) || App::MonM::Daemon::DAEMONFORKS,
        uid     => $usr,
        gid     => $grp,
        saferun => $options->{safemode},
    );
$exitval = $daemon->ctrl($dash_k); # For exiting
exit $exitval;

__END__

lib/App/MonM/Channel/Command.pm  view on Meta::CPAN

    # Get command string
    my $command = lvalue($self->chconf, "command") || lvalue($self->chconf, "script");
    unless ($command) {
        $self->error("Command string incorrect");
        return 0;
    }

    my $phone = $self->message->recipient;
    my $command_res = dformat($command, {
            ID      => $self->message->msgid,
            TO      => $self->message->to,
            RCPT    => $phone, RECIPIENT => $phone,
            PHONE   => $phone, NUM => $phone, TEL => $phone, NUMBER => $phone, MSISDN => $phone,
            TIME    => time(), DATETIME => date_time2dig(), DATE => date2dig(),
            SUBJECT => $self->message->subject, SUBJ => $self->message->subject, SBJ => $self->message->subject,
            MESSAGE => $self->message->subject, MSG => $self->message->subject,
        });

    # Get content body
    my $ct_type = lc(lvalue($self->chconf, "content") || "body");

lib/App/MonM/Channel/Email.pm  view on Meta::CPAN

use Email::Sender::Transport::SMTP;
use Try::Tiny;

use App::MonM::Util qw/ set2attr /;

sub sendmsg {
    my $self = shift;
    return $self->maybe::next::method() unless $self->type eq 'email';
    my $message = $self->message;

    #printf "Send message %s to %s (%s) via %s\n", $self->message->msgid, $self->message->to, $self->message->recipient,  $self->type;
    #print App::MonM::Util::explain($self->chconf);

    # eXtra headers (extension headers)
    $message->email->header_str_set("X-Mailer" => sprintf("%s/%s", __PACKAGE__, $VERSION) );

    # SMTP Options
    my $options = set2attr($self->chconf) || {};
    #print App::MonM::Util::explain($options);

    # General

lib/App/MonM/Channel/File.pm  view on Meta::CPAN

    return $self->maybe::next::method() unless $self->type eq 'file';
    my $message = $self->message;

    # Options
    my $options = set2attr($self->chconf) || {};
    #print App::MonM::Util::explain($options);

    # File
    my $filemask = value($self->chconf, "filemask") || value($self->chconf, "file") || FILEMASK;
    my $filename = dformat($filemask, {
            ID      => $self->message->msgid,
            TO      => $self->message->to,
            RCPT    => $self->message->recipient, RECIPIENT => $self->message->recipient,
            EXT     => FILEEXT,
            TIME    => time(), DATETIME=> date_time2dig(), DATE    => date2dig(),
        });
    my $dir = value($self->chconf, "directory") || value($self->chconf, "dir") || File::Spec->tmpdir;
    my $file;
    if (File::Spec->file_name_is_absolute($filename)) {
        $file = $filename;
    } else {

lib/App/MonM/Channel/File.pm  view on Meta::CPAN

        }
        $file = File::Spec->catfile($dir, $filename);
    }

    # Save
    $message->save($file) or do {
        $self->error($message->error);
        return 0;
    };

    #printf "Send message %s to %s (%s) via %s\n", $self->message->msgid, $self->message->to, $self->message->recipient,  $self->type;

    return 1;
}

1;

__END__

lib/App/MonM/Message.pm  view on Meta::CPAN

Generate new ID of message

=head2 load

    my $message = App::MonM::Message->new;
    $message->load("test.msg") or die $message->error;

Load message from file

=head2 msgid

    my $MessageId = $message->msgid;

Returns MessageId (X-Message-ID)

=head2 recipient

    my $recipient = $message->recipient;

Returns recipient

=head2 save

lib/App/MonM/Message.pm  view on Meta::CPAN

my @CHARS = ('a'..'f', 0..9);
my %UNIQCNT;

sub new {
    my $class = shift;
    my %args = @_;

    my $self = bless {
            email => undef, # Email::SMTP object
            msgid => undef, # X-Message-ID
            recipient => "",
            error => "",
            fnv32a => CTK::Digest::FNV32a->new(),
        }, $class;

    # No any data - returns empty object (without email)
    return $self unless %args;

    # Headers
    my $headers = $args{headers} || {};

lib/App/MonM/Message.pm  view on Meta::CPAN

        parts      => [ @parts ],
    );

    # Add attributes and body for single message
    #$email->content_type_set($contenttype);
    #$email->charset_set($charset);
    #$email->encoding_set($encoding);
    #$email->body_str_set($body);

    # Add X-Message-ID
    $self->{msgid} = $self->genId($to, $recipient, $subject);
    $email->header_str_set("X-Message-ID" => $self->{msgid});

    # Add X-Recipient
    $self->{recipient} = $recipient;
    $email->header_str_set("X-Recipient" => $recipient);

    # Done
    $self->email($email);

    return $self;
}

lib/App/MonM/Message.pm  view on Meta::CPAN

    my $v = shift;
    $self->{email} = $v if defined $v;
    return $self->{email};
}
sub error {
    my $self = shift;
    my $v = shift;
    $self->{error} = $v if defined $v;
    return $self->{error};
}
sub msgid {
    my $self = shift;
    return $self->{msgid};
}
sub genId {
    my $self = shift;
    my @arr = @_;
    unshift @arr, $$;
    my $text = join("|", @arr);
    my $t = time;
    my $short = $t & 0x7FFFFF;
    my $fnv = $self->{fnv32a}->digest($text) & 0xFFFFFFFF;
    my $salt = join '', map {; $CHARS[rand @CHARS] } (0..6);

lib/App/MonM/Message.pm  view on Meta::CPAN

    # Set email object
    my $email = Email::MIME->new($buf);
    $self->email($email);
    my $to = $email->header("To");

    # Add X-Recipient
    my $recipient = $email->header("X-Recipient") || $to || USERNAME;
    $self->{recipient} = $recipient;

    # Add X-Message-ID
    my $msgid = $email->header("X-Message-ID");
    unless ($msgid) {
        my $subject = $email->header("Subject");
        $msgid = $self->genId($to, $subject);
        $email->header_str_set("X-Message-ID" => $msgid);
    }
    $self->{msgid} = $msgid;

    return $self;
}
sub recipient {
    my $self = shift;
    return $self->{recipient};
}
sub to {
    my $self = shift;
    my $val = $self->email->header("To");

lib/App/MonM/Util.pm  view on Meta::CPAN

    my $hash = run_cmd($command, $timeout, $stdin);

Wrapped L<IPC::Cmd/run_forked> function

This function returns hash:

    {
        'cmd'     => 'perl -w',
        'code'    => 0, # Exit code (errorlevel)
        'message' => 'OK', # OK/ERROR
        'pgid'    => 176294, # Pid of child process
        'status'  => 1, # 1/0
        'stderr'  => '', # STDERR
        'stdout'  => '', # STDOUT
    }

=item B<set2attr>

    my $hash = set2attr({set => ["AttrName Value"]}); # {"AttrName" => "Value"}

Converts attributes from the "set" format to regular hash

lib/App/MonM/Util.pm  view on Meta::CPAN

    my %args = ();
    $args{timeout} = $timeout if $timeout;
    $args{child_stdin} = $exe_in if $exe_in;

    my $r = {};
    $r = run_forked( $cmd, \%args) if $cmd;


    my %ret = (
        cmd     => $r->{cmd} // $cmd,
        pgid    => $r->{child_pgid} || 0,
        code    => $r->{exit_code} || 0,
        stderr  => $r->{stderr} // '',
        stdout  => $r->{stdout} // '',
        status  => $r->{exit_code} ? 0 : 1,
        message => $r->{exit_code} ? 'ERROR' : 'OK',
    );
    chomp($ret{stderr});
    chomp($ret{stdout});

    # Time outed