How should I redirect users in a formmail script? - perl

So I'm using a basic formmail script. Within the script I'm using a redirect variable. The value of the redirect is something like:
http://www.mysite.com/NewOLS_GCUK_EN/bling.aspx?BC=GCUK&IBC=CSEE&SIBC=CSEE
When the redirect action happens however, the URL appears in the browser as:
http://www.mysite.com/NewOLS_GCUK_EN/bling.aspx?BC=GCUK&IBC=CSEE&SIBC=CSEE
You can see the & characters are replaced with &
Is there any way to fix this?

Maybe you can edit the script with a string substitution:
$myRedirectURL =~ s/\&/\&/g;
Or perhaps look in the script where the opposite substitution is taking place, and comment out that step.

HTML::Entities's decode_entities could decode this for you:
$redirect_target = decode_entities($redirect_target);
But passing the destination URL as HTTP argument (e.g. hidden form field) is dangerous (as #Sinan Ünür already said in the comments). Better store the target URL within your script and pass a selector from the form:
if ($selector eq 'home') { $target_url = 'http://www.foo.bar/'; }
elsif ($selector eq 'bling') { $target_url = 'http://www.foo.bar/NewOLS_GCUK_EN/bling.aspx'; }
else {
$target_url = 'http://www.foo.bar/default.html'; # Fallback/default value
}
Using a Hash would be shorter:
my %targets = {
home => 'http://www.foo.bar/',
bling => '/NewOLS_GCUK_EN/bling.aspx',
};
$target_url = $targets{$selector} || '/default_feedback_thanks.html';

Related

How would I match the correct hash pair based on a specific string?

I have a simple page hit tracking script that allows for the output to display friendly names instead of urls by using a hash.
UPDATE: I used php to generate the hash below, but used the wrong dynamic page name of item.html. When changed to the correct name, the script returns the desired results. Sorry for wasting anyone's time.
my %LocalAddressTitlePairs = (
'https://www.mywebsite.com/index.html' => 'HOME',
'https://www.mywebsite.com/art_gallery.html' => 'GALLERY',
'https://www.mywebsite.com/cart/item.html?itemID=83&cat=26' => 'Island Life',
'https://www.mywebsite.com/cart/item.html?itemID=11&cat=22' => 'Castaways',
'https://www.mywebsite.com/cart/item.html?itemID=13&cat=29' => 'Pelicans',
and so on..
);
The code for returning the page hits:
sub url_format {
local $_ = $_[0] || '';
if ((m!$PREF{'My_Web_Address'}!i) and (m!^https://(.*)!i) ) {
if ($UseLocalAddressTitlePairs == 1) {
foreach my $Address (keys %LocalAddressTitlePairs) {
return "<a title=\"$Address\" href=\"$_\">$LocalAddressTitlePairs{$Address}</A>" if (m!$_$! eq m!$Address$!);
}
}
my $stub =$1;
return $stub;
}
}
Displaying the log hits will show
HOME with the correct link, GALLERY with the correct url link, but https://www.mywebsite.com/cart/item.html?itemID=83&cat=26
will display a random name instead of what it should be, Island Life for this page.. it has the correct link,-- a different name displays every time the page is loaded.
And, the output for all pages with query strings will display the exact same name. I know the links are correct by clicking thru site pages and checking the log script for my own page visits.
I tried -
while (my($mykey, $Value) = each %LocalAddressTitlePairs) {
return "<a title=\"$mykey\" href=\"$_\">$Value</a>" if(m!$_$! eq m!$mykey$!);
but again, the link is correct but the mykey/Value associated is random too. Way too new to perl to figure this out but I'm doing a lot of online research.
m!$Address$! does not work as expected, because the expression contains special characters such as ?
You need to add escape sequences \Q and \E
m!\Q$Address\E$!
it’s even better to add a check at the beginning of the line, otherwise
my $url = "https://www.mywebsite.com/?foo=bar"
my $bad_url = "https://bad.com?u=https://www.mywebsite.com/?foo=bar"
$bad_url =~ m!\Q$url\E$! ? 1 : 0 # 1, pass
$bad_url =~ m!^\Q$url\E$! ? 1 : 0 # 0, fail

Typoscript: how do I add a parameter to all links in the RTE?

I want to add a parameter to all links entered in the RTE by the user.
My initial idea was to do this:
lib.parseFunc_RTE.tags.link {
typolink.parameter.append = TEXT
typolink.parameter.append.value = ?flavor=lemon
}
So for example:
http://domain.com/mypage.php
becomes
http://domain.com/mypage.php?flavor=lemon
which sounds great -- as long as the link does not already have a query string!
In that case, I obviously end up with two question marks in the URL
So for example:
http://domain.com/prefs.php?id=1234&unit=moon&qty=300
becomes
http://domain.com/prefs.php?id=1234&unit=moon&qty=300?flavor=lemon
Is there any way to add my parameter with the correct syntax, depending on whether the URL already has a query string or not? Thanks!
That would be the solution:
lib.parseFunc_RTE.tags.link {
typolink.additionalParams = &flavor=lemon
}
Note that it has to start with an &, typo3 then generates a valid link. The parameter in the link also will be parsed with realURL if configured accordingly.
Edit: The above solution only works for internal links as described in the documentation https://docs.typo3.org/typo3cms/TyposcriptReference/Functions/Typolink/Index.html
The only solution that works for all links that I see is to use a userFunc
lib.parseFunc_RTE.tags.link {
typolink.userFunc = user_addAdditionalParams
}
Then you need to create a php script and include in your TS with:
includeLibs.rteScript = path/to/yourScript.php
Keep in mind that includeLibs is outdated, so if you are using TYPO3 8.x (and probably 7.3+) you will need to create a custom extension with just a few files
<?php
function user_addAdditionalParams($finalTagParts) {
// modify the url in $finalTagParts['url']
// $finalTagParts['TYPE'] is an indication of link-kind: mailto, url, file, page, you can use it to check if you need to append the new params
switch ($finalTagParts['TYPE']) {
case 'url':
case 'file':
$parts = explode('#', $finalTagParts['url']);
$finalTagParts['url'] = $parts[0]
. (strpos($parts[0], '?') === false ? '?' : '&')
. 'newParam=test&newParam=test2'
. ($parts[1] ? '#' . $parts[1] : '');
break;
}
return '<a href="' . $finalTagParts['url'] . '"' .
$finalTagParts['targetParams'] .
$finalTagParts['aTagParams'] . '>'
}
PS: i have not tested the actual php code, so it can have some errors. If you have troubles, try debugging the $finalTagParts variable
Test whether the "?" character is already in the URL and append either "?" or "&", then append your key-value pair. There's a CASE object available in the TypoScript Reference, with an example you can modify for your purpose.
For anyone interested, here's a solution that worked for me using the replacement function of Typoscript. Hope this helps.
lib.parseFunc_RTE.tags.link {
# Start by "replacing" the whole URL by itself + our string
# For example: http://domain.com/?id=100 becomes http://domain.com/?id=100?flavor=lemon
# For example: http://domain.com/index.html becomes http://domain.com/index.html?flavor=lemon
typolink.parameter.stdWrap.replacement.10 {
#this matches the whole URL
search = #^(.*)$#i
# this replaces it with itself (${1}) + our string
replace =${1}?flavor=lemon
# in this case we want to use regular expressions
useRegExp = 1
}
# After the first replacement is done, we simply replace
# the first '?' by '?' and all others by '&'
# the use of Option Split allow this
typolink.parameter.stdWrap.replacement.20 {
search = ?
replace = ? || & || &
useOptionSplitReplace = 1
}
}

How to keep the first parameter value only?

In my Perl Catalyst application, I get the value of a URL parameter like this, typically:
my $val = $c->request->params->{arg} || '';
But the URL could contain multiple arg=$Val. I only want to keep the first value of arg=. I could add this throughout my code:
my $val = $c->request->params->{arg} || '';
$val = $val->[0] if (ref($val) eq 'ARRAY');
That is rather ugly. Is there a way to pick up the first value or a url parameter in a better way?
Does your app actually expect multiple values for parameter arg? If not, all you need is
my $val = $c->request->params->{arg} || '';
Sure, it will be garbage if the user provides you with a garbage url, but there's nothing you can do to prevent the user from giving you garbage.
If it's actually valid to have more than one value for parameter arg, why would you want just the first value? You'd actually want all the values.
sub param_vals {
my ($params, $name) = #_;
return () if !exists($params->{name});
return $params->{$name} if !ref($params->{name});
return #{ $params->{$name} };
}
my #args = param_vals($c->request->{params}, 'arg');
I just read the code to Catalyst::Request but I don't see anything to always pull out a single value. Too bad Cat doesn't use something like Hash::MultiValue!

WWW::Mechanize::Firefox looping though links

I am using a foreach to loop through links. Do I need a $mech->back(); to continue the loop or is that implicit.
Furthermore do I need a separate $mech2 object for nested for each loops?
The code I currently have gets stuck (it does not complete) and ends on the first page where td#tabcolor3 is not found.
foreach my $sector ($mech->selector('a.link2'))
{
$mech->follow_link($sector);
foreach my $place ($mech->selector('td#tabcolor3'))
{
if (($mech->selector('td#tabcolor3', all=>1)) >= 1)
{
$mech->follow_link($place);
print $_->{innerHTML}, '\n'
for $mech->selector('td.dataCell');
$mech->back();
}
else
{
$mech->back();
}
}
You cannot access information from a page when it is no longer on display. However, the way foreach works is to build the list first before it is iterated through, so the code you have written should be fine.
There is no need for the call to back as the links are absolute. If you had used click then there must be a link in the page to click on, but with follow_link all you are doing is going to a new URL.
There is also no need to check the number of links to follow, as a for loop over an empty list will simply not be executed.
To make things clearer I suggest that you assign the results of selector to an array before the loop.
Like this
my #sectors = $mech->selector('a.link2');
for my $sector (#sectors) {
$mech->follow_link($sector);
my #places = $mech->selector('td#tabcolor3');
for my $place (#places) {
$mech->follow_link($place);
print $_->{innerHTML}, '\n' for $mech->selector('td.dataCell');
}
}
Update
My apologies. It seems that follow_link is finicky and needs to follow a link on the current page.
I suggest that you extract the href attribute from each link and use get instead of follow_link.
my #selectors = map $_->{href}, $mech->selector('a.link2');
for my $selector (#selectors) {
$mech->get($selector);
my #places = map $_->{href}, $mech->selector('td#tabcolor3');
for my $place (#places) {
$mech->get($place);
print $_->{innerHTML}, '\n' for $mech->selector('td.dataCell');
}
}
Please let me know whether this works on the site you are connecting to.
I recommend to use separate $mech object for this:
foreach my $sector ($mech->selector('a.link2'))
{
my $mech = $mech->clone();
$mech->follow_link($sector);
foreach my $place ($mech->selector('td#tabcolor3'))
{
if (($mech->selector('td#tabcolor3', all=>1)) >= 1)
{
my $mech = $mech->clone();
$mech->follow_link($place);
print $_->{innerHTML}, '\n'
for $mech->selector('td.dataCell');
#$mech->back();
}
# else
# {
# $mech->back();
# }
}
I am using WWW:Mechanize::Firefox to loop over a bunch of URLs with loads of Javascript. The page does not render immediately so need test if a particular page element is visible (similar to suggestion in Mechanize::Firefox documentation except 2 xpaths in the test) before deciding next action.
The page eventually renders a xpath to 'no info' or some wanted stuff after about 2-3 seconds. If no info we go to next URL. I think there is some sort of race condition with both xpaths not existing at once causing the MozRepl::RemoteObject: TypeError: can't access dead object error intermittently (at the sleep 1 in the loop oddly enough).
My solution that seems to work/improve reliability is to enclose all the $mech->getand$mech->is_visible in an eval{}; like this:
eval{
$mech->get("$url");
$retries = 15; #test to see if element visible = page complete
while ($retries-- and ! $mech->is_visible( xpath => $xpath_btn ) and ! $mech->is_visible( xpath => $xpath_no_info )){
sleep 1;
};
last if($mech->is_visible( xpath => $xpath_no_info) ); #skip rest if no info page
};
Others might suggest improvements on this.

How should I treat strings of digits in XML::RPC and Drupal?

I am trying to use an XML-RPC server on my Drupal (PHP) backend to make it easier for my Perl backend to talk to it. However, I've run into an issue and I'm not sure which parts, if any, are bugs. Essentially, some of the variables I need to pass to Drupal are strings that sometimes are strings full of numbers and the Drupal XML-RPC server is returning an error that when a string is full of numbers it is not properly formed.
My Perl code looks something like this at the moment.
use strict;
use warnings;
use XML::RPC;
use Data::Dumper;
my $xmlrpc = XML::RPC->new(URL);
my $result = $xmlrpc->call( FUNCTION, 'hello world', '9876352345');
print Dumper $result;
The output is:
$VAR1 = {
'faultString' => 'Server error. Invalid method parameters.',
'faultCode' => '-32602'
};
When I have the Drupal XML-RPC server print out the data it receives, I notice that the second argument is typed as i4:
<param>
<value>
<i4>9876352345</i4>
</value>
I think when Drupal then finishes processing the item, it is typing that variable as an int instead of a string. This means when Drupal later tries to check that the variable value is properly formed for a string, the is_string PHP function returns false.
foreach ($signature as $key => $type) {
$arg = $args[$key];
switch ($type) {
case 'int':
case 'i4':
if (is_array($arg) || !is_int($arg)) {
$ok = FALSE;
}
break;
case 'base64':
case 'string':
if (!is_string($arg)) {
$ok = FALSE;
}
break;
case 'boolean':
if ($arg !== FALSE && $arg !== TRUE) {
$ok = FALSE;
}
break;
case 'float':
case 'double':
if (!is_float($arg)) {
$ok = FALSE;
}
break;
case 'date':
case 'dateTime.iso8601':
if (!$arg->is_date) {
$ok = FALSE;
}
break;
}
if (!$ok) {
return xmlrpc_error(-32602, t('Server error. Invalid method parameters.'));
}
}
What I'm not sure about is on which side of the divide the issue lies or if there is something else I should be using. Should the request from the Perl side be typing the content as a string instead of i4 or is the Drupal side of the request too stringent for the string type? My guess is that the issue is the latter, but I don't know enough about how an XML-RPC server is supposed to work to know for sure.
The number 9876352345 is too big to fit in a 32bit integer. That might cause the problem.
are you using frontier? perhaps you could declare the string explicitly?
my $result =
$xmlrpc->call( FUNCTION, 'hello world', $xmlrpc->string('9876352345') );
info from the client docs:
By default, you may pass ordinary Perl values (scalars) to be encoded. RPC2 automatically converts them to XML-RPC types if they look like an integer, float, or as a string. This assumption causes problems when you want to pass a string that looks like "0096", RPC2 will convert that to an because it looks like an integer.
I don't have any experience with the XML::RPC package, but I'm the author of the RPC::XML CPAN module. As with the Frontier package, I provide a way to force a value into a specific type when it would otherwise default to something else.
If I had to guess, I would say that the package you're using simple does a regular-expression match on the data to decide how to type it. I had a similar problem with my package, and given the way Perl handles scalar values the only real way around it is to force it with explicit declaration. As a previous answerer pointed out, the value in question is actually outside the range of the <i4> type (which is a signed 32-bit value). So even if you had intended it to be an integer value, it would have been invalid with regards to the XML-RPC spec.
I would recommend switching to one of the other XML-RPC packages, which have clearer ways of explicitly typing data. According to the docs for XML::RPC, it is possible to force the typing of data, but I found it to be unclear and not very well explained.