Cobol interface with C - cobol

So, i'm work with C and OpenCobol, and, I whant to know if have an way to get the value of a internal cobol source...
for example (based on sample of this link):
http://www.opencobol.org/modules/bwiki/index.php?cmd=read&page=UserManual%2F2_3
---- say.cob ---------------------------
IDENTIFICATION DIVISION.
PROGRAM-ID. say.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 TESTE PIC 9(9) VALUE ZEROS.
LINKAGE SECTION.
01 HELLO PIC X(6).
01 WORLD PIC X(6).
PROCEDURE DIVISION USING HELLO WORLD.
MOVE 456 TO TESTE.
DISPLAY TESTE.
DISPLAY HELLO WORLD.
*> RETURN TESTE. ??????
EXIT PROGRAM.
----------------------------------------
And, the C code when I use is that:
---- hello.c ---------------------------
#include <stdio.h>
#include <libcob.h>
extern int say(char *hello, char *world);
int
main()
{
int ret;
char hello[6] = "Hello ";
char world[6] = "World!";
cob_init(0, NULL);
ret = say(hello, world); // return the 000000456 ??????????
// How to make this :(
return ret;
}
----------------------------------------
Or, have an whay to get the cobol variable, something like this:
// ... code ...
int value = cob_getvar(TESTE);
// ... code ...

Look at page 7-7 of the OpenCOBOL Programmers Guide. For the data that you want to pass back to your C program, add another argument and pass it by reference to the COBOL program. Declare your TESTE as binary to match the C declaration. You can also pass back the automatically-defined RETURN-CODE, if you like. So your COBOL would be something like this:
DATA DIVISION.
LINKAGE SECTION.
01 HELLO PIC X(6).
01 WORLD PIC X(6).
01 TESTE PIC S9(9) USAGE BINARY-LONG.
PROCEDURE DIVISION USING
BY VALUE HELLO
BY VALUE WORLD
BY REFERENCE TESTE.
0000-MAIN-ROUTINE.
MOVE 456 TO TESTE
MOVE 1 TO RETURN-CODE
GOBACK.
And in your calling program:
int teste;
int returnCode;
char hello[6] = "Hello ";
char world[6] = "World!";
cob_init(0, NULL);
returnCode = say(hello, world, &teste);

Alexandre;
OpenCOBOL 2.0 will have FUNCTION-ID allowing for things like
MOVE FUNCTION nextbigthing(args) TO cobol-working-store
Until it is released though, we are "limited" to CALL, ENTRY, PROGRAM-ID and the like.
For an example of some low level function pointer related things, take a look at
http://opencobol.add1tocobol.com/#what-stock-call-library-does-opencobol-offer
which includes a snippet for setting error handlers and exit procedures. Scan that with an eye on
PROCEDURE-POINTER
ENTRY
SET proc-ptr TO ENTRY "link-name"
CALL ... USING ... RETURNING
with the caveat, that this is one way. There are others. The ENTRY lines can be full on PROGRAM-ID subprograms, etc. Section 5 of the OpenCOBOL FAQ is rife with routines that pass data back and forth from other languages and link libraries.
Also, look to cob_field in libcob/common.h. The C code generated by CALL sets up an array of the COBOL fields of the arguments, along with the actual call frame, and these COBOL field structures can be accessed from C functions through cob_module.
errorproc.cob
>>SOURCE FORMAT IS FIXED
*****************************************************************
* OpenCOBOL demonstration
* Author: Brian Tiffin
* Date: 26-Jun-2008
* History:
* 03-Jul-2008
* Updated to compile warning free according to standards
* Purpose:
* CBL_ERROR_PROC and CBL_EXIT_PROC call example
* CBL_ERROR_PROC installs or removes run-time error procedures
* CBL_EXIT_PROC installs or removes exit handlers
* Also demonstrates the difference between Run time errors
* and raised exceptions. Divide by zero raises an
* exception, it does not cause a run time error.
* NB:
* Please be advised that this example uses the functional but
* now obsolete ENTRY verb. Compiling with -Wall will display
* a warning. No warning will occur using -std=MF
* Tectonics: cobc -x errorproc.cob
identification division.
program-id. error_exit_proc.
data division.
working-storage section.
* entry point handlers are procedure addresses
01 install-address usage is procedure-pointer.
01 install-flag pic 9 comp-x value 0.
01 status-code pic s9(9) comp-5.
* exit handler address and priority (prio is IGNORED with OC1.1)
01 install-params.
02 exit-addr usage is procedure-pointer.
02 handler-prio pic 999 comp-x.
* indexing variable for back scannning error message strings
01 ind pic s9(9) comp-5.
* work variable to demonstrate raising exception, not RTE
01 val pic 9.
* mocked up error procedure reentrancy control, global level
01 once pic 9 value 0.
88 been-here value 1.
* mocked up non-reentrant value
01 global-value pic 99 value 99.
* LOCAL-STORAGE SECTION comes into play for ERROR_PROCs that
* may themselves cause run-time errors, handling reentry.
local-storage section.
01 reenter-value pic 99 value 11.
* Linkage section for the error message argument passed to proc
* By definition, error messages are 325 alphanumeric
linkage section.
01 err-msg pic x(325).
* example of OpenCOBOL error and exit procedures
procedure division.
* Demonstrate problem installing procedure
* get address of WRONG handler. NOTE: Invalid address
set exit-addr to entry "nogo-proc".
* flag: 0 to install, 1 to remove
call "CBL_EXIT_PROC" using install-flag
install-params
returning status-code
end-call.
* status-code 0 on success, in this case expect error.
if status-code not = 0
display
"Intentional problem installing EXIT PROC"
", Status: " status-code
end-display
end-if.
* Demonstrate install of an exit handler
* get address of exit handler
set exit-addr to entry "exit-proc".
* flag: 0 to install, 1 to remove
call "CBL_EXIT_PROC" using install-flag
install-params
returning status-code
end-call.
* status-code 0 on success.
if status-code not = 0
display
"Problem installing EXIT PROC"
", Status: " status-code
end-display
stop run
end-if.
* Demonstrate installation of an error procedure
* get the procedure entry address
set install-address to entry "err-proc".
* install error procedure. install-flag 0 installs, 1 removes
call "CBL_ERROR_PROC" using install-flag
install-address
returning status-code
end-call.
* status-code is 0 on success.
if status-code not = 0
display "Error installing ERROR PROC" end-display
stop run
end-if.
* example of error that raises exception, not a run-time error
divide 10 by 0 giving val end-divide.
* val will be a junk value, use at own risk
divide 10 by 0 giving val
on size error display "DIVIDE BY ZERO Exception" end-display
end-divide.
* intentional run-time error
call "erroneous" end-call. *> ** Intentional error **
* won't get here. RTS error handler will stop run
display
"procedure division, following run-time error"
end-display.
display
"global-value: " global-value
", reenter-value: " reenter-value
end-display.
exit program.
*****************************************************************
*****************************************************************
* Programmer controlled Exit Procedure:
entry "exit-proc".
display
"**Custom EXIT HANDLER (will pause 3 and 0.5 seconds)**"
end-display.
* sleep for 3 seconds
call "C$SLEEP" using "3" end-call.
* demonstrate nanosleep; argument in billionth's of seconds
* Note: also demonstrates OpenCOBOL's compile time
* string catenation using ampersand;
* 500 million being one half second
call "CBL_OC_NANOSLEEP" using "500" & "000000" end-call.
exit program.
*****************************************************************
* Programmer controlled Error Procedure:
entry "err-proc" using err-msg.
display "**ENTER error procedure**" end-display.
* These lines are to demonstrate local and working storage
display
"global-value: " global-value
", reenter-value: " reenter-value
end-display.
* As reenter-value is local-storage
* the 77 will NOT display on rentry, while the global 66 will
move 66 to global-value.
move 77 to reenter-value.
* Process err-msg.
* Determine Length of error message, looking for null terminator
perform varying ind from 1 by 1
until (err-msg(ind:1) = x"00") or (ind = length of err-msg)
continue
end-perform.
display err-msg(1:ind) end-display.
* demonstrate trapping an error caused in error-proc
if not been-here then
set been-here to true
display "Cause error while inside error-proc" end-display
call "very-erroneous" end-call *> Intentional error
end-if.
* In OpenCOBOL 1.1, the return-code is local and does
* not influence further error handlers
*move 1 to return-code.
move 0 to return-code.
display "**error procedure EXIT**" end-display.
exit program.

Related

Microfocus animator says "perform level=01" even though the program it is presently in is a subprogram and called from another program

I am facing a problem while debugging a COBOL program, When using animator and when a call is made to another COBOL program with a CALL ... USING statement.
After entering the sub program and pressing P (for Perform) E (for Exit). The animator asks "Perform Level = 1 Zoom to calling program ?", and on pressing Y(for Yes) Animator shows the message "Perform Level 1", and doesn't proceed to the the next line in the calling program (i.e, MAIN.COB) .
The only option available then is to Zoom all along which is not helping much during debugging.
Is there a runtime Switch or a Compiler option to make animator pass the control back to the calling program
Example:
This is the main program that iam debugging
IDENTIFICATION DIVISION.
PROGRAM-ID. MAIN.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-STUDENT-ID PIC 9(4) VALUE 1000.
01 WS-STUDENT-NAME PIC A(15) VALUE 'Tim'.
PROCEDURE DIVISION.
CALL 'UTIL' USING WS-STUDENT-ID, WS-STUDENT-NAME.
DISPLAY 'Student Id : ' WS-STUDENT-ID
DISPLAY 'Student Name : ' WS-STUDENT-NAME
STOP RUN.
This is the called program, UTIL,
IDENTIFICATION DIVISION.
PROGRAM-ID. UTIL.
DATA DIVISION.
LINKAGE SECTION.
01 LS-STUDENT-ID PIC 9(4).
01 LS-STUDENT-NAME PIC A(15).
PROCEDURE DIVISION USING LS-STUDENT-ID, LS-STUDENT-NAME.
DISPLAY 'In Called Program'.
MOVE 1111 TO LS-STUDENT-ID.
EXIT PROGRAM.
So when iam debugging MAIN program, and pass control to UTIL subroutine (by Perform and Step ). when i try to return back to calling program MAIN, animator gives the message "Perform Level = 1 Zoom to calling program ? Y/N" - when i press Y is shows a message at lower left saying ""Perform Level = 1" and doesnt skip to the program MAIN
When we look at the Perform / Call stack ( by pressing P and V ) animator displays the below Stack view
Perform/Call Stack View-----------------------------------
Program Name Section Name
----------------------------------------------------------
UTIL.int No Section or Paragraph
---------------------------------------------------------
Zoon Scroll <so on... >
---------------------------------------------------------
As you can see, only the Sub module is visible in the stack. Whereas it should have been.
Perform/Call Stack View-----------------------------------
Program Name Section Name
----------------------------------------------------------
UTIL.int No Section or Paragraph
MAIN.int No Section or Paragraph
---------------------------------------------------------
Zoon Scroll <so on... >
---------------------------------------------------------
(i.e., The calling point from the MAIN.int should also be visible)
This is why i suspect it has something to do with some missing compilation option or Environment settings

COBOL function output as string

123456*
IDENTIFICATION DIVISION.
PROGRAM-ID. "EVEN-OR-ODD".
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Num-1 PIC 9(02).
02 Answer PIC XXXX.
PROCEDURE DIVISION.
GOBACK.
EVEN-OR-ODD.
IF FUNCTION REM(NUM-1, 2) = 0
COMPUTE ANSWER = "Even"
ELSE
COMPUTE ANSWER = "Odd"
END-IF
END PROGRAM EVEN-OR-ODD.
Its a simple even odd function. It should check if number is even return "even" else return "odd"
Can someone explain what's wrong ?
So much things a COBOL compiler would have told you...
GOBACK as first statement, so the rest would not be executed
the program misses a final period and a necessary/reasonable (that depends on the compiler) statement to end the program (END PROGRAM is only parsed for the compilation phase) - you likely want to move your GOBACK. to the end
COMPUTE does not set anything to alphanumeric, you likely want MOVE
there is no way to know what the program would have done, so possibly want DISPLAY instead of MOVE
NUM-1 is never set and has no initial VALUE - so it could theoretically even abend

Data type in COBOL

I have written the following program, I am confused why when I compile the program I get an error saying that A-COL(1,1) is not a numeric value while displaying A-COL(1,1) gives me 1.
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DIFF PIC 9(3).
01 ARRAY.
05 A-ROW OCCURS 99 TIMES.
10 A-COL OCCURS 2 TIMES.
15 TABLE-CONTENT PIC 9(3).
PROCEDURE DIVISION.
MOVE 1 TO A-COL(1,1).
MOVE 2 TO A-COL(2,1).
DISPLAY A-COL(1,1).
COMPUTE DIFF = A-COL(1,1) - A-COL(2,1).
DISPLAY DIFF.
STOP RUN.
Change the A-COL definition to
"10 A-COL PIC 9(3) OCCURS 2 TIMES."
and remove the TABLE-CONTENT.
Group variables are considered alphanumeric (X type) so cannot be used in a computation.
Alternatively you may do this - refer to the address location using the actual numeric field.
PROCEDURE DIVISION.
MOVE 1 TO TABLE-CONTENT(1,1).
MOVE 2 TO TABLE-CONTENT(2,1).
DISPLAY A-COL(1,1).
COMPUTE DIFF = TABLE-CONTENT(1,1) - TABLE-CONTENT(2,1).
DISPLAY DIFF.
Also you might want to make DIFF signed.
Additional Information
A-COL(1,1) displays "1" because it stores the data as "1xx" where x = space. That is not a numeric value. When you run the solutions here you will notice that display line produces "001".
Keep your WORKING-STORAGE structure the same. However, your data-elements are not A-COL, but THE-CONTENT. So use THE-CONTENT, not A-COL.
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DIFF PIC S9(3).
01 ARRAY.
05 A-ROW
OCCURS 99 TIMES.
10 A-COL
OCCURS 2 TIMES.
15 TABLE-CONTENT PIC 9(3).
PROCEDURE DIVISION.
MOVE 1 TO TABLE-CONTENT ( 1 1 )
MOVE 2 TO TABLE-CONTENT ( 2 1 )
DISPLAY
">"
TABLE-CONTENT ( 1 1 )
"<"
COMPUTE DIFF = TABLE-CONTENT ( 1 1 )
- TABLE-CONTENT ( 2 1 )
DISPLAY
">"
DIFF
"<"
STOP RUN
.
Your structure is better, because it is easier to maintain. If you ever want to REDEFINES TABLE-CONTENT, you can, without changing the structure. Not so if you "complicate" the structure now.
Yes, if you MOVE a numeric literal to a group-item, an alpha-numeric MOVE is carried out, the result will be your literal left-justified and space-padded to the right, or truncated to the right, or just fitting, depending on the size of your literal.
Although conceptually you have "columns" in your table (COBOL doesn't have arrays, it has tables with OCCURS), be aware that you cannot access a column as a whole. In storage you have row-1-col-1, row-1-col-2, row-2-col-1, row-2-col-2 through to row-99-col-1, row-99-col-2.
Any arithmetic (ADD, SUBTRACT, MULTIPLY, DIVIDE and COMPUTE) can only use numeric fields or literals as source-data. It is not enough that a field contains "a number", it must be a numeric field.
The GIVING (of ADD, SUBTRACT, MULTIPLY and DIVIDE) can place the result in a non-numeric field of a particular type, a numeric-edited field. This is a field with a PICture clause containing numeric-editing PICture symbols.

How to display an absolute value

Given the following code:
IDENTIFICATION DIVISION.
PROGRAM-ID. FABS.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 NUM PIC 9 VALUE ZEROS.
01 ABSVAL PIC 99 VALUE ZEROS.
PROCEDURE DIVISION.
PROGRAM-BEGIN.
DISPLAY "This program returns the absolute value of a number.".
DISPLAY SPACE.
DISPLAY "Input value: " WITH NO ADVANCING.
ACCEPT NUM.
IF (NUM = -0) THEN
COMPUTE ABSVAL = 0
ELSE
IF (NUM > 0) THEN
COMPUTE ABSVAL = 0
ELSE
COMPUTE ABSVAL = ABSVAL * -1
END-IF
END-IF.
DISPLAY "|", NUM "| = ", ABSVAL.
PROGRAM-DONE.
STOP RUN.
Why is the output zero? Is there something wrong? And how do you make a signed/negative input?
Thinking of your task, rather than why you get zero, it is easy.
Let's assume you get a signed value with your ACCEPT.
01 value-from-accept PIC S9.
01 absolute-value-for-output PIC 9.
MOVE value-from-accept TO absolute-value-for-output
DISPLAY
"|"
value-from-accept
"| = "
absolute-value-for-output
You may think that something is wrong with the output from value-from-accept (depending on compiler) but you can always MOVE it to a numeric-edited field and DISPLAY that.
Tip: To reverse the sign of a signed field.
SUBTRACT field-to-reverse-sign
FROM ZERO
GIVING the-reversed-field
SUBTRACT is faster than MULTIPLY.
You have defined your field which is ACCEPTed as unsigned.
The first two "legs" of your nested-IF set ABSVAL to zero. The remaining leg takes the existing value of ABSVAL (from the VALUE ZEROS, so it is zero) and multiplies it by minus one. Getting -ve zero (possibly), but then storing it in an unsigned field. So ABSVAL will always be zero when you come to the DISPLAY.
You define a signed field by prefixing the PICture string with an S:
01 a-signed-field PIC S9(5).
Depending on your compiler, you can type a - when entering the data and it'll be held happily as a negative value in a signed field (which you have to define) or you have to code for it yourself.
after your correction above
I am not sure how you are testing it but to just to ensure that the values are stored correct you may want to have both the fields signed i.e. pic S9 or pic S99. Its possible that without the preceding S (sign) the variables are not really storing the negative sign regardless of what the screen is showing.
pls observe what results you get then

use SHA1 with COBOL

I was wondering if there's any way to apply SHA1 hash with COBOL.
If there's at least some info of how the SHA1 algorithm works it will be usefull.
Thanks
You didn't say which Cobol platform. If you are on z/OS, there are a variety of cryptography services that are easily called from Cobol. And SHA1 is available among those services.
I did a small sample embedding Python in COBOL, and picked an MD5 checksum as an example.
I wouldn't necessarily go with Python, but if you are lucky enough to be able to use OpenCOBOL, then all the features of libcrypto are a simple CALL away.
For completeness, having mentioned the Python angle, but again that's pretty hefy baggage if the goal is simply cryptography. In which case OpenSSL would be a much tighter fit. This listing is very likely NOT suitable for your needs, but it shows off the power of CALL and the C application binary interface. Please excuse me if this is just noise.
From SourceForge:
Very high level Python embedding is pretty straight forward, been there, done that.
>>SOURCE FORMAT IS FIXED
*> *******************************************************
*> Author: Brian Tiffin
*> Date: 20130126
*> Purpose: Embed Python
*> Tectonics: cobc -x cobpy.cob -lpython2.6
*> *******************************************************
identification division.
program-id. cobpy.
procedure division.
call "Py_Initialize"
on exception
display "link cobpy with -lpython2.6" end-display
end-call
call "PyRun_SimpleString" using
by reference
"from time import time,ctime" & x"0a" &
"print('Today is', ctime(time()))" & x"0a" & x"00"
on exception continue
end-call
call "Py_Finalize" end-call
goback.
end program cobpy.
Giving
$ cobc -x cobpy.cob -lpython2.6
$ ./cobpy
('Today is', 'Sat Jan 26 20:01:41 2013')
Python dutifully displayed the tuple.
But what fun is Python if it is just for high level script side effects? Lots, but still.
Pure embedding.
>>SOURCE FORMAT IS FIXED
*> *******************************************************
*> Author: Brian Tiffin
*> Date: 20130126
*> Purpose: Embed Python
*> Tectonics: cobc -x cobkat.cob -lpython2.6
*> NOTES: leaks, no Py_DECREF macros called.
*> *******************************************************
identification division.
program-id. cobkat.
data division.
working-storage section.
77 python-name usage pointer.
77 python-module usage pointer.
77 python-dict usage pointer.
77 python-func usage pointer.
77 python-stringer usage pointer.
77 python-args usage pointer.
77 python-value usage pointer.
01 cobol-buffer-pointer usage pointer.
01 cobol-buffer pic x(80) based.
01 cobol-string pic x(80).
01 cobol-integer usage binary-long.
01 command-line-args pic x(80).
*> *******************************************************
procedure division.
call "Py_Initialize"
on exception
display "link cobpy with -lpython" end-display
end-call
*> Python likes module names in Unicode
call "PyUnicodeUCS4_FromString" using
by reference "pythonfile" & x"00"
returning python-name
on exception
display "unicode problem" end-display
end-call
*> import the module, using PYTHONPATH
call "PyImport_Import" using
by value python-name
returning python-module
on exception
display "this would be borked" end-display
end-call
if python-module equal null
display "no pythonfile.py in PYTHONPATH" end-display
end-if
*> within the module, an attribute is "pythonfunction"
call "PyObject_GetAttrString" using
by value python-module
by reference "pythonfunction" & x"00"
returning python-func
on exception continue
end-call
*>
*> error handling now skimped out on
*>
*> pythonfunction takes a single argument
call "PyTuple_New" using
by value 1
returning python-args
end-call
*> of type long, hard coded to the ultimate answer
call "PyLong_FromLong" using
by value 42
returning python-value
end-call
*> set first (only) element of the argument tuple
call "PyTuple_SetItem" using
by value python-args
by value 0
by value python-value
end-call
*> call the function, arguments marshalled for Python
call "PyObject_CallObject" using
by value python-func
by value python-args
returning python-value
end-call
*> we know we get a long back, hopefully 1764
call "PyLong_AsLong" using
by value python-value
returning cobol-integer
end-call
display "Python returned: " cobol-integer end-display
*> **************************************************** *<
*> a function taking string and returning string
call "PyObject_GetAttrString" using
by value python-module
by reference "pythonstringer" & x"00"
returning python-stringer
end-call
call "PyTuple_New" using
by value 1
returning python-args
end-call
*> Use the OpenCOBOL command argument
accept command-line-args from command-line end-accept
call "PyString_FromString" using
by reference
function concatenate(
function trim(command-line-args)
x"00")
returning python-value
end-call
*> Set the function argument tuple to the cli args
call "PyTuple_SetItem" using
by value python-args
by value 0
by value python-value
end-call
*> call the "pythonstringer" function
call "PyObject_CallObject" using
by value python-stringer
by value python-args
returning python-value
end-call
*> return as String (with the MD5 hex digest tacked on)
call "PyString_AsString" using
by value python-value
returning cobol-buffer-pointer
end-call
*> one way of removing null while pulling data out of C
set address of cobol-buffer to cobol-buffer-pointer
string
cobol-buffer delimited by x"00"
into cobol-string
end-string
display "Python returned: " cobol-string end-display
*> and clear out <*
call "Py_Finalize" end-call
goback.
end program cobkat.
with pythonfile.py
#
# Simple Python sample for OpenCOBOL embedding trial
#
def pythonfunction(i):
return i * i
import hashlib
def pythonstringer(s):
sum = hashlib.md5()
sum.update(s)
return s + ": " + sum.hexdigest()
Giving
$ ./cobkat Python will use this for MD5 hash
no pythonfile.py in PYTHONPATH
Attempt to reference unallocated memory (Signal SIGSEGV)
Abnormal termination - File contents may be incorrect
Oops
$ export PYTHONPATH=.
$ ./cobkat Python will use this for MD5 hash
Python returned: +0000001764
Python returned: Python will use this for MD5 hash: c5577e3ab8dea11adede20a1949b5fb3
Haven't done one of these in a while, fun.
Cheers,
Brian
Oh, in case you're reading along, 1764 is the ultimate answer, squared.
Here's a more on point source listing. Requires OpenCOBOL 1.1CE for the OC_CBL_DUMP
First up, is paying homage to the authors of OpenSSL. They deserve credits.
OpenSSL License
---------------
/* ====================================================================
* Copyright (c) 1998-2011 The OpenSSL Project. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in
* the documentation and/or other materials provided with the
* distribution.
*
* 3. All advertising materials mentioning features or use of this
* software must display the following acknowledgment:
* "This product includes software developed by the OpenSSL Project
* for use in the OpenSSL Toolkit. (http://www.openssl.org/)"
*
* 4. The names "OpenSSL Toolkit" and "OpenSSL Project" must not be used to
* endorse or promote products derived from this software without
* prior written permission. For written permission, please contact
* openssl-core#openssl.org.
*
* 5. Products derived from this software may not be called "OpenSSL"
* nor may "OpenSSL" appear in their names without prior written
* permission of the OpenSSL Project.
*
* 6. Redistributions of any form whatsoever must retain the following
* acknowledgment:
* "This product includes software developed by the OpenSSL Project
* for use in the OpenSSL Toolkit (http://www.openssl.org/)"
*
* THIS SOFTWARE IS PROVIDED BY THE OpenSSL PROJECT ``AS IS'' AND ANY
* EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE OpenSSL PROJECT OR
* ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
* OF THE POSSIBILITY OF SUCH DAMAGE.
* ====================================================================
*
* This product includes cryptographic software written by Eric Young
* (eay#cryptsoft.com). This product includes software written by Tim
* Hudson (tjh#cryptsoft.com).
*
*/
Original SSLeay License
-----------------------
/* Copyright (C) 1995-1998 Eric Young (eay#cryptsoft.com)
* All rights reserved.
*
* This package is an SSL implementation written
* by Eric Young (eay#cryptsoft.com).
* The implementation was written so as to conform with Netscapes SSL.
*
* This library is free for commercial and non-commercial use as long as
* the following conditions are aheared to. The following conditions
* apply to all code found in this distribution, be it the RC4, RSA,
* lhash, DES, etc., code; not just the SSL code. The SSL documentation
* included with this distribution is covered by the same copyright terms
* except that the holder is Tim Hudson (tjh#cryptsoft.com).
*
* Copyright remains Eric Young's, and as such any Copyright notices in
* the code are not to be removed.
* If this package is used in a product, Eric Young should be given attribution
* as the author of the parts of the library used.
* This can be in the form of a textual message at program startup or
* in documentation (online or textual) provided with the package.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* "This product includes cryptographic software written by
* Eric Young (eay#cryptsoft.com)"
* The word 'cryptographic' can be left out if the rouines from the library
* being used are not cryptographic related :-).
* 4. If you include any Windows specific code (or a derivative thereof) from
* the apps directory (application code) you must include an acknowledgement:
* "This product includes software written by Tim Hudson (tjh#cryptsoft.com)"
*
* THIS SOFTWARE IS PROVIDED BY ERIC YOUNG ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*
* The licence and distribution terms for any publically available version or
* derivative of this code cannot be changed. i.e. this code cannot simply be
* copied and put under another distribution licence
* [including the GNU Public Licence.]
*/
And some COBOL to exercise the cryptography and the two forms of SHA1 hashing
>>source format is free
*> ***************************************************************
*> Author: Brian Tiffin
*> Date: 20130321
*> Purpose: Compute an SHA1 digest, whole
*> Tectonics: cobc -x sha1a.cob -lcrypto
*> ***************************************************************
IDENTIFICATION DIVISION.
program-id. sha1a.
data division.
working-storage section.
01 sha1-digest pic x(20).
01 digestable pic x(80) value "this message needs to be verified".
*> ***************************************************************
procedure division.
*> Compute disgest from block of memory
call "SHA1" using
by reference digestable
by value function length(function trim(digestable))
by reference sha1-digest
on exception
display "link sha1.cob with OpenSSL's libcrypto" end-display
end-call
*> Dump the hash, as it'll unlikely be printable
call "CBL_OC_DUMP" using
by reference sha1-digest
on exception continue
end-call
goback.
end program sha1a.
With a sample run of
$ cobc -x sha1a.cob
$ ./sha1a
link sha1.cob with OpenSSL's libcrypto
Offset HEX-- -- -- -5 -- -- -- -- 10 -- -- -- -- 15 -- CHARS----1----5-
000000 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
000016 20 20 20 20
$ cobc -x sha1a.cob -lcrypto
$ ./sha1a
Offset HEX-- -- -- -5 -- -- -- -- 10 -- -- -- -- 15 -- CHARS----1----5-
000000 c7 3b 52 0c 61 39 9b f9 a5 2f fe 3f 11 90 5e 10 .;R.a9.../.?..^.
000016 3b 0d 15 c5 ;...
And a more complete example, building the digest from multiple updates.
Assumptions here: This will crack on files with trailing spaces.
>>source format is free
*> ***************************************************************
*> Author: Brian Tiffin
*> Date: 20130321
*> Purpose: Compute an SHA1 digest, by piece
*> Tectonics: cobc -x sha1.cob -lcrypto
*> ***************************************************************
IDENTIFICATION DIVISION.
program-id. sha1.
environment division.
configuration section.
input-output section.
file-control.
select samplefile
assign to "sha1.cob"
organization is line sequential
file status is sample-status
.
DATA DIVISION.
file section.
fd samplefile.
01 input-line pic x(2048).
working-storage section.
01 sha1-context usage pointer.
01 sha1-libresult usage binary-long.
88 sha1-success value 1 when set to false is 0.
01 sha1-digest pic x(20).
01 sample-status pic 9999.
01 sample-file-state pic 9.
88 no-more-sample value 9 when set to false is 0.
01 sha-ctx-structure pic x(1024).
*> ***************************************************************
PROCEDURE DIVISION.
*> Compute disgest from a sequential file
open input samplefile
if sample-status not equal to zero
display "Status of " sample-status " returned from open" end-display
display "rest of sample run will be garbage" end-display
end-if
*> Init the SHA1 internals
set sha1-context to address of sha-ctx-structure
call "SHA1_Init" using
by value sha1-context
returning sha1-libresult
on exception
display "Can't find SHA1_Init. hint: cobc -x sha1 -lcrypto" end-display
end-call
if not sha1-success
display "Could not initialize SHA1 structures" end-display
display "normally you'd want to stop run and call the emergency hotline to wake up the support techs, but this is an example and blindly continues." end-display
end-if
*> loop across some data, ignoring issue of trailing spaces on input lines
read samplefile at end set no-more-sample to true end-read
if input-line equal spaces then
move x"0a" to input-line(1:1)
else
move function concatenate(function trim(input-line trailing), x"0a") to input-line
end-if
perform until no-more-sample
call "SHA1_Update" using
by value sha1-context
by content function trim(input-line trailing)
by value function length(function trim(input-line trailing))
on exception display "internal update failure of SHA1_Update" end-display
end-call
if not sha1-success
display "Could not update SHA1 structures" end-display
display "normally you'd want to stop run." end-display
end-if
read samplefile at end set no-more-sample to true end-read
if input-line equal spaces then
move x"0a" to input-line(1:1)
else
move function concatenate(function trim(input-line trailing), x"0a") to input-line
end-if
end-perform
*> finalize the disgest
call "SHA1_Final" using
by reference sha1-digest
by value sha1-context
on exception display "you're kidding right? internal failure of SHA1_Final" end-display
end-call
close samplefile
*> Dump the hash, as it'll unlikely be printable
call "CBL_OC_DUMP" using
by reference sha1-digest
on exception continue
end-call
goback.
END PROGRAM sha1.
and another sample run of
$ cobc -x sha1.cob -lcrypto
$ ./sha1
Offset HEX-- -- -- -5 -- -- -- -- 10 -- -- -- -- 15 -- CHARS----1----5-
000000 d4 04 4b ed 02 e8 ef 54 e0 c4 73 0b 6b 51 85 bc ..K....T..s.kQ..
000016 85 73 d3 16 .s..
$ openssl sha1 sha1.cob
SHA1(sha1.cob)= d4044bed02e8ef54e0c4730b6b5185bc8573d316
SHA1 rquires a lot of bitwise operations (XOR,AND,OR) which are not generally supported in COBOL (they are supported by a few compilers).
Your best bet would be to simply adjust one of the many C implementations so it can be easily called as a COBOL subroutine.
Information on your platform and compiler would be useful.
Yes, there's a way to apply SHA1 hash with COBOL.
I have written the SHA256 hashing algorithm in COBOL, with heaps of telemetry everywhere to let you know exactly what is going on at all points along the way.
If you can do SHA256 in COBOL, you can do SHA-1 in COBOL.
Don't squib it by hashing small input character strings.
Make sure your program works for reams of input characters, so that it can be used for document authentication.
If you've understood the entire specs, then your result for that will be correct as well.
And then, see if you can hash the hash - like bitcoin does.
That is a little bit more tricky than it looks like on face value.
I have assumed that you have to do the coding in COBOL itself,
so that YOU do the real work - not just call a subprogram which someone else has written.
Anyone could do that, so you wouldn't be asking if it was just that.
Look on Github to see how the SHA256 algorithm works.
It also shows example animated intermediate calculations, not just the final result.
IMO finding the full specification is BY FAR the hardest thing.
There's a number of youtube videos, but they are describing only a few tiny parts of the full story.
But if you have ANY weakness in your COBOL skills, especially table processing, but also in structuring your code, EVEN IF YOU FINALLY UNDERSTAND THE SPECS, you'll have a lot of trouble converting SPECS into working code, depending on how you want to get your code written. Transform centred design helps.
This link is a good help as well.
https://hackernoon.com/how-sha-2-works-a-step-by-step-tutorial-sha-256-46103t6k
Use it AND the Github stuff together, but they don't both use the same example input string.
In summary, this about your analysis skills, design skills, coding skills and testing skills - if you want it to be.
Good Luck.
Let us all know how you go.
Added 18th July 2021
FYI
https://github.com/DoHITB/CryptoCobol/blob/main/SHA1HEX.CBL

Resources