Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Seekers of Perl Wisdom

( #479=superdoc: print w/replies, xml ) Need Help??

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
DBI problem connecting MYSQL using secure connection
2 direct replies — Read more / Contribute
by ddrazin
on Jan 13, 2017 at 07:24
    Iím using perl 5.22.0 and DBD::mysql version 4.041 installed with -ssl option. I have successfully connected to remote mysql from linux shell using CA file:
    mysql -h database_host -u username --password=password --ssl-ca= /path +_to_CA_file/ca-cert.pem
    Only CA file is used for connection to database, X509 CA cert and X509 CA key are not required.Iím trying to connect using following command:
    my $dbhost = "database_host"; my $dbuser = "username"; my $dbpw = "password"; my $cafile = "/path_to_CA_file/ca-cert.pem"; #my $key = undef; #my $cert = undef; my $dbname = "dbname"; my $dbtable = "dbtable"; my $dbh = DBI->connect("DBI:mysql:database=$dbname;host=$dbhost;mysql_ +ssl=1;mysql_ssl_ca_file=$cafile","$dbuser", "$dbpw",{'RaiseError' => +1}) or die "Error in connecting to database";
    And I have SSL connection error 2026 I didn't find in DBD::mysql readme which flag are mandatory bellow you can find DBD:myql attributes/flags description:
    mysql_ssl
    A true value turns on the CLIENT_SSL flag when connecting to the MySQL database:
    mysql_ssl=1 --------> specified in command
    This means that your communication with the server will be encrypted.
    Please note that this can only work if you enabled SSL when compiling DBD::mysql; this is the default starting version 4.034. See DBD::mysql::INSTALL for more details.
    If you turn mysql_ssl on, you might also wish to use the following flags:
    mysql_ssl_client_key ----> not required for connection but I'm not sure is it mandatoray in perl
    mysql_ssl_client_cert ----> not required for connection but I'm not sure is it mandatoray in perl
    mysql_ssl_ca_file --------> specified in command
    mysql_ssl_ca_path
    mysql_ssl_cipher
    These are used to specify the respective parameters of a call to mysql_ssl_set, if mysql_ssl is turned on.
    Could you please help me in finding solution?
Using setuid() and absorbing that user's groups
3 direct replies — Read more / Contribute
by Chagrin
on Jan 12, 2017 at 19:10
    My root user is a member of the following groups (output from "id" command):

    uid=0(root) gid=0(root) groups=0(root),1(bin),2(daemon),3(sys),4(adm),6(disk),10(wheel)

    An unprivileged user is a member of the following groups:

    uid=5002(jim) gid=5002(jim) groups=5002(jim),666(software)

    My problem is that when I attempt to set the effective UID of my process, in order to execute a command with the same privileges as the unprivileged user, that unprivileged user's group (the "software" group) is not included as an available group. To demonstrate this a short script:

    print `id`; $( = 5002; $< = 5002; print `id`;

    Which has an output of:

    uid=0(root) gid=0(root) groups=0(root),1(bin),2(daemon),3(sys),4(adm), +6(disk),10(wheel) uid=5002(jim) gid=5002(jim) euid=0(root) egid=0(root) groups=0(root),1 +(bin),2(daemon),3(sys),4(adm),6(disk),10(wheel)

    How do I eliminate the privileged user's secondary groups and, more importantly, replace them with the unprivileged user's secondary groups?
And plus OR
5 direct replies — Read more / Contribute
by htmanning
on Jan 12, 2017 at 16:29
    Monks,

    What am I doing wrong? This does not work:

    if (($username eq "$security") && ($type ne "Check In" || $type ne + "Check Out")) {

    But this does work:

    if (($username eq "$security") && ($type ne "Check In")) {

    I need to add several more arguments for $type. If the $username is correct and 3 or 4 $types are not true, I want to print something, but I can't get it to work. I'm missing something.

[SOLVED]: Can't find 'boot_...' symbol when trying to use an installed XS module
1 direct reply — Read more / Contribute
by stevieb
on Jan 12, 2017 at 16:03

    update: Solved in Re: Can't find 'boot_...' symbol when trying to use an installed XS module. /update

    I'm working on my next Raspberry Pi project, and am having an issue using the XS module. I generated the XS using Inline::C, copied the file into the distribution directory, and compiled it successfully. However, I'm getting:

    Can't find 'boot_RPi__ADC__MCP3008' symbol in /usr/local/lib/perl/5.18 +.2/auto/RPi/ADC/MCP3008/MCP3008.so at /usr/local/lib/perl/5.18.2/RPi/ADC/MCP3008.pm line 12.

    I've gone through an hour's worth of search results, but none explain how I should fix this so I'm at a bit of a loss. All I know is that the error is being generated by XSLoader.

    Can the XS Monks have a look to see what I may be missing? I'll happily provide more information/code/files if necessary.

    My XS code:

    #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include <stdio.h> #include <stdlib.h> #include <unistd.h> #include <stdint.h> #include <string.h> #include <errno.h> #include <wiringPi.h> #include <wiringPiSPI.h> static int fd; void load_spi_driver (){ if (system("gpio load spi") == -1){ fprintf (stderr, "Can't load the SPI driver: %s\n", strerror ( +errno)) ; exit (EXIT_FAILURE) ; } } void spi_setup (int spi_channel){ if ((fd = wiringPiSPISetup(spi_channel, 1000000)) < 0){ fprintf (stderr, "Can't open the SPI bus: %s\n", strerror (err +no)) ; exit (EXIT_FAILURE) ; } } int fetch (int load_spi, int spi, int mode, int input){ if(load_spi == TRUE){ loadSpiDriver(); } wiringPiSetup () ; spiSetup(spi); if(mode == 1){ // single-ended requires 0x08 mode = mode << 3; } if(input < 0 || input > 7){ return -1; } // start bit unsigned char buffer[3] = {1}; buffer[1] = (mode + input) << 4; wiringPiSPIDataRW(spi, buffer, 3); // get the last 10 bits return ((buffer[1] & 3) << 8) + buffer[2]; } MODULE = MCP3008 PACKAGE = MCP3008 PROTOTYPES: DISABLE void load_spi_driver () PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; load_spi_driver(); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ void spi_setup (spi_channel) int spi_channel PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; spi_setup(spi_channel); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */ int fetch (load_spi, spi, mode, input) int load_spi int spi int mode int input

    The relevant piece in the module:

    require XSLoader; XSLoader::load('RPi::ADC::MCP3008', $VERSION);

    ...and just in case, my makefile:

    use strict; use warnings FATAL => 'all'; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'RPi::ADC::MCP3008', AUTHOR => q{Steve Bertrand <steveb@cpan.org>}, VERSION_FROM => 'lib/RPi/ADC/MCP3008.pm', ABSTRACT_FROM => 'lib/RPi/ADC/MCP3008.pm', LICENSE => 'Perl_5', PL_FILES => {}, LIBS => ['-lwiringPi', '-lpthread'], MIN_PERL_VERSION => 5.006, CONFIGURE_REQUIRES => { 'ExtUtils::MakeMaker' => 0, }, BUILD_REQUIRES => { 'Test::More' => 0, }, PREREQ_PM => { }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'RPi-ADC-MCP3008-*' }, );
double underscore in http-header
2 direct replies — Read more / Contribute
by morgon
on Jan 12, 2017 at 14:30
    Hi,

    I am try to configure a modem that has a http-api.

    When I capture what the browser-based GUI does I can see that it sends http-headers that look like this:

    __RequestVerificationToken: acP92nszWSeNIAeL/Al9Rj24scVQXt+o
    This is what I try to replicate in a perl-script.

    What I do is this:

    my $mech = WWW::Mechanize->new; my $r = HTTP::Request->new("POST", $some_url); $r->header("__RequestVerificationToken" => $key); # set content and some other headers here $mech->request($r);
    But when I capture what the script sends I find that the leading underscores seem to get replaced with minuses, i.e.
    --RequestVerificationToken: whatever
    So my question is: Why is that and how can I turn it off so I can send headers with leading double-underscores?

    Many thanks!

Cannot get Perl to match a specific string in my textfile
3 direct replies — Read more / Contribute
by skasch
on Jan 12, 2017 at 09:50
    Dear list,

    I am a beginner with Perl and seek wisdom of the monks

    What i want is to read a file, run a regex on its lines and when matching substitute some strings according to a map.

    Mostly that does work but on a specific line, i cannot get my regex to match and I like to understand why

    This is an excerpt of one of the files that should be processed

    "user.name@domain.com:Calendar/personal" = <*I0>; }; SubscribedFolders = ( "user@domain.com:Calendar/BCA-513DD600-1B-6967B200" ); FoldersOrder = ( personal, "user_A_domain_D_com_BCA-513DD600-1B-6967B200", "7D03-5682B480-975-5FFE8000", "7D03-5682B480-977-5FFE8000" ); FreeBusyExclusions = { "user.name@domain.com:Calendar/personal" = <*I0>; "user@domain.com:Calendar/BCA-513DD600-1B-6967B200" = <*I1>;

    And this is my Code

    #!/usr/bin/perl use strict; use warnings; use autodie; my %replacements = ( 'user.name@domain.com' => 'uname', 'user@domain.com' => 'user', ); open( my $readFile, '<', "sampleFile" ); while ( <$readFile> ) { # if contains :Calendar and is suffixed with / # or :Contacts with same suffix or Users prefixed # with / or is an email-address followed by " = if ( m/:Calendar(?=\/)/, m/:Contacts(?=\/)/, m/(?<=\"\/)Users/, m/.+@.+\"\s=/) { # then replace every occurrence as in list foreach my $key ( sort keys %replacements ) { s/\b$key\b/$replacements{$key}/g; } } print $_; }

    And this is the result

    "uname:Calendar/personal" = <*I0>; }; SubscribedFolders = ( "user@domain.com:Calendar/BCA-513DD600-1B-6967B200" ); FoldersOrder = ( personal, "user_A_domain_D_com_BCA-513DD600-1B-6967B200", "7D03-5682B480-975-5FFE8000", "7D03-5682B480-977-5FFE8000" ); FreeBusyExclusions = { "uname:Calendar/personal" = <*I0>; "user:Calendar/BCA-513DD600-1B-6967B200" = <*I1>;

    I do not understand why my regex does not match the string under "Subscribed Folders" any help is greatly appreciated

    cheers, Sascha
EOF problem with Dancer streaming proxy
2 direct replies — Read more / Contribute
by dsheroh
on Jan 12, 2017 at 08:59
    I have a system which needs to act as a proxy to another of our servers, mainly for legacy support reasons. With the help of Dancer as a proxy, I've managed to get it mostly working with the following code:
    return send_file( \'ignored', streaming => 1, callbacks => { override => sub { eval { my $client_connection = shift; my $ua = LWP::UserAgent->new; my $client; my $status = $ua->get($real_url, ':content_cb' => sub { my ($data, $resp) = @_; unless ($client) { my $headers_in = $resp->headers; my %headers_out = ( 'Content-Disposition' => sprintf('inline; filename="%s"', $file->{fileName}), ); for (qw( Content-Type Content-Length Keep-Alive Last-Mod +ified )) { $headers_out{$_} = $headers_in->header($_) if $headers_in->header($_); } $client = $client_connection->([$resp->code, [%headers_o +ut]]); } $client->write($data); }); if ($status->is_error) { my $headers_in = $status->headers; my %headers_out; for (qw( Content-Type Content-Length Keep-Alive Last-Modif +ied )) { $headers_out{$_} = $headers_in->header($_) if $headers_in->header($_); } my $client = $client_connection->([$status->code, [%header +s_out]]); $client->write($status->error_as_HTML); } 1; } or warn "Proxy failure: $@"; return; }, }, );
    I say "mostly working" because, while the files are streamed successfully and browsers will accept them without complaint, wget and curl are less forgiving. Both of these command-line programs issue errors after the file is (successfully) received:
    $ curl -sS -o rcvd https://foo/bar.pdf curl: (18) transfer closed with outstanding read data remaining $ wget https://foo/bar.pdf <...> 2017-01-12 14:48:58 (6.10 MB/s) - Read error at byte 3316868 (Success. +).Retrying. <proceeds to loop endlessly>
    The byte at which wget reports the read error is always the last byte of the file (i.e., equal to the file size), leading me to suspect that an EOF marker isn't being handled properly. Possibly also relevant is that, while the proxying code copies the Content-Length header from the original source, the original source does not provide that header, so Content-Length is not actually set.

    Using curl/wget to download the file directly from the original source works perfectly with no error messages issued.

    Does anyone have any insights as to what the cause of the problem might be?

perl script
2 direct replies — Read more / Contribute
by ronak
on Jan 12, 2017 at 08:22
    my $ex = QA::STK::Execute->new(ip=>'some ip',user=>'root'); $ex->command("ls-l"); my $rc = $ex->execute(); my $output = $ex->output();
    if want to check whether xyz file in present in " ls-l" , how to do that
cpan.search links blocked by Norton Internet Security
3 direct replies — Read more / Contribute
by BillKSmith
on Jan 11, 2017 at 16:29
    I have recently discovered that many module (e.g. Template::Toolkit) README links on cpan.search are blocked by Norton Internet Security. Is this a real concern? Do I have an option set wrong? Can anyone else fix the problem?
    Bill
Comparing string to array elements
3 direct replies — Read more / Contribute
by R56
on Jan 11, 2017 at 13:02

    Hey all! Hoping someone can help me solve a little problem.

    I'm parsing a block of free text in a file, and I have a pre-loaded array of specific terms.

    When I parse that block of text into a string, I'm looking to cross reference each word on that string with the terms I have on the array. If there's a match between the two, print it out.

    if($text =~ /upperboundary(.+)lowerboundary/s){ if(grep {$_ eq $1} @terms){ print OUT "$1\t"; } }

    This doesn't work, and I searched for a while on how to do it, to no avail. Can someone point me in a better direction? Thanks in advance!


Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    [Discipulus]: buongiorno a te!
    [choroba]: LanX ciao! BTW, yesterday evening I arrived home in my new car ;-)
    [Discipulus]: it seems some signal is issued but only by services
    [Discipulus]: which one choroba?
    [choroba]: Perlingo

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (5)
    As of 2017-01-17 09:27 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      Do you watch meteor showers?




      Results (154 votes). Check out past polls.